COMMENT ⊗   VALID 00033 PAGES VERSION 17-1(61)
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	HISTORY
C00012 00003	COMMENT Indices, Bits for IOSER 
C00015 00004	COMMENT Simio, Ioinst, Lpryer, Cserr 
C00023 00005	COMMENT Getchn 
C00026 00006	COMMENT Filnam 
C00031 00007	COMMENT Flscan 
C00033 00008	COMMENT Open 
C00039 00009
C00045 00010	Release 
C00050 00011	COMMENT Lookup, Enter 
C00053 00012	COMMENT Fileinfo 
C00055 00013	Out 
C00058 00014	Input 
C00070 00015	COMMENT Realin, Realscan 
C00072 00016	COMMENT Intin, Intscan 
C00074 00017	DSCR NUMIN
C00077 00018	NUMIN -- CONTD.
C00081 00019	SCAN (CALLED BY NUMIN AND STRIN)
C00086 00020	   Character table for SCAN (Realscan,Intscan,Realin,Intin)
C00088 00021	DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
C00090 00022	COMMENT Arryout, Wordout 
C00095 00023	Arryin, Wordin 
C00106 00024	COMMENT Linout 
C00108 00025	Breakset,setbreak,stdbrk fakes
C00109 00026	Close, Closin, Closo
C00111 00027	COMMENT Mtape 
C00113 00028	COMMENT  Useti, Useto, Rename 
C00116 00029	where Usercon used to be
C00117 00030	Ttyuuo functions 
C00121 00031	
C00134 00032	Ptyuuo functions 
C00143 00033
C00144 ENDMK
C⊗;
COMMENT ⊗HISTORY
AUTHOR,REASON
021  102100000075  ⊗;


COMMENT ⊗
VERSION 17-1(61) 10-18-74 BY rls check herefks
VERSION 17-1(60) 10-14-74 BY JFR FIX BUG IN INPUT
VERSION 17-1(59) 10-14-74 BY JFR REMOVE HACK'S
VERSION 17-1(58) 10-13-74 BY JFR %BS% BREAK TABLE BUGS
VERSION 17-1(57) 10-11-74 BY JFR FIS TYPOS %BS%
VERSION 17-1(56) 10-11-74 BY JFR MINOR FIX TO INPUT %BS%
VERSION 17-1(55) 10-11-74 BY RHT FEAT %BQ% MAKE CLOSE TAKE INHIBIT BITS AS ARG
VERSION 17-1(54) 10-11-74 BY JFR REMOVE HEREFK'S
VERSION 17-1(53) 10-11-74 BY JFR FEAT %BS% NEW WAY TO DO BREAK TABLES
VERSION 17-1(52) 10-10-74 BY JFR FEAT %BS% NEW WAY TO DO BREAK TABLES
VERSION 17-1(51) 9-27-74 BY JFR FIX AUTHOR REASON STUFF
VERSION 17-1(50) 8-8-74 BY LDE BUG #TB# TYPO IN INPUT PREVENTED SETPL PAGENUM TO WORK
VERSION 17-1(49) 5-24-74 
VERSION 17-1(48) 5-24-74 
VERSION 17-1(47) 5-24-74 BY rht mode saibrk & saiprn to strser
VERSION 17-1(46) 5-24-74 
VERSION 17-1(45) 5-24-74 
VERSION 17-1(44) 5-24-74 
VERSION 17-1(43) 5-24-74 
VERSION 17-1(42) 5-24-74 
VERSION 17-1(41) 5-24-74 
VERSION 17-1(40) 5-19-74 
VERSION 17-1(39) 5-19-74 
VERSION 17-1(38) 5-19-74 
VERSION 17-1(37) 5-19-74 
VERSION 17-1(36) 5-5-74 BY RHT ADD $PRINT
VERSION 17-1(35) 5-5-74 
VERSION 17-1(34) 5-5-74 
VERSION 17-1(33) 5-5-74 BY  JRL BUG #RX# (CMU =B7=) LDE  SAYS SOSNUM,LINNUM,PAGNUM S/B INITIALIZED
VERSION 17-1(32) 3-26-74 BY RHT FEAT %AX% FINISH UP SETPL (POLISH IT LATER!!!)
VERSION 17-1(31) 3-26-74 BY RHT SOMEONE (ON 12 MARCH 1974) RAN SOS ON THIS FILE!
			IF ANY TIME BOMBS WERE PLANTED, WE WILL FIND OUT!
VERSION 17-1(30) 2-22-74 BY RHT FEAT %BG% ADD BREAKSET MODE "F"
VERSION 17-1(29) 2-1-74 BY RHT BUG #QY# USBSTS NEEDED PATCHING
VERSION 17-1(28) 2-1-74 
VERSION 17-1(27) 1-12-74 BY RHT MAKE COUNT RIGHT IN INOUT
VERSION 17-1(26) 1-12-74 
VERSION 17-1(25) 1-12-74 BY RHT FIX COMPIL FOR SAITTY
VERSION 17-1(24) 1-11-74 BY RHT TTYINL STUFF
VERSION 17-1(23) 1-11-74 BY RHT MERGE IN CMU CHANGES
VERSION 17-1(22) 1-11-74 
VERSION 17-1(21) 1-11-74 
VERSION 17-1(20) 1-11-74 
VERSION 17-1(19) 1-11-74 
VERSION 17-1(18) 12-15-73 BY RFS FIX BUGS QC,QD.
VERSION 17-1(17) 12-10-73 BY JRL REMOVE LAST REFERENCES TO PGNNO
VERSION 17-1(16) 12-10-73 
VERSION 17-1(15) 12-10-73 
VERSION 17-1(14) 12-8-73 BY JRL REMOVE SPECIAL STANFORD CHARACTERS(WHERE POSSIBLE)
VERSION 17-1(13) 12-8-73 BY RFS MAKE ALTMODE 33 FOR EXPORT SYSTEMS
VERSION 17-1(12) 12-5-73 BY RHT BUG #PO#
VERSION 17-1(11) 12-5-73 
VERSION 17-1(10) 12-5-73 
VERSION 17-1(9) 12-3-73 BY RFS REMOVE ALL III DISPLAY STUFF
VERSION 17-1(8) 12-2-73 BY RHT FIX INPUT
VERSION 17-1(7) 12-2-73 BY RLS EDIT
VERSION 17-1(6) 12-2-73 BY RHT ALSO SOME WRD SPARES
VERSION 17-1(5) 12-2-73 BY RHT FEAT %AV% CHNCDB.  ALSO SPARES ADDED TO OPN & BRK
VERSION 17-1(4) 12-2-73 
VERSION 17-1(3) 12-1-73 BY RLS BUG #PM#  DONT LOSE A CHAR IN INPUT
VERSION 17-1(2) 12-1-73 BY RLS ADD SETPL FUNCTION
VERSION 17-1(1) 7-27-73 BY JRL CHANGE OPEN TO FACT THAT RELEASE NOW TAKES TWO ARGUMENTS
VERSION 17-1(0) 7-26-73 BY RHT **** VERSION 17 ****
VERSION 16-2(45) 5-7-73 BY JRL CHANGE PTYALL TO HANDLE LARGER BUFFERS
VERSION 16-2(44) 3-21-73 BY JRL ADD COMPIL(SAIDM3)
VERSION 16-2(43) 2-25-73 BY RHT BUG #LP# GO TO OUT OF PROCESS SHOULDNT LOOP!
VERSION 16-2(42) 2-14-73 BY RHT BUG #LM# TYPO IN PITBND
VERSION 16-2(41) 1-9-73 BY RHT REPAIR COMPIL FOR SAIPIT
VERSION 16-2(40) 12-2-72 BY RHT MODIFY PIT STUFF FOR NEW INFOTAB &DATAB
VERSION 16-2(39) 12-1-72 BY JRL CHANGE LEAP INDEX USED TO CALL FRELS WITHIN BEXIT
VERSION 16-2(38) 11-28-72 BY RHT ADD CLEANUPS TO BEXIT CODE
VERSION 16-2(37) 9-24-72 BY JRL LIBRARY REQUESTS
VERSION 16-2(36) 9-21-72 BY JRL ADD DADDY CURSCB ETC TO DUM
VERSION 16-2(35) 8-31-72 BY JRL RELEASE VALUE SETS CORRECTLY IN STKUWD
VERSION 16-2(34) 8-27-72 BY RHT CHANGE SPOT IN WHICH STKUWD SAVES RETN
VERSION 16-2(33) 8-23-72 BY JRL ADD FORGET CONTEXT CODE TO BEXIT
VERSION 16-2(32) 8-14-72 BY RHT EVAL NOW NAMED APPLY
VERSION 16-2(31) 7-22-72 BY RHT ADD KILL LIST TO BEXIT
VERSION 16-2(30) 7-12-72 BY DCS BUG #IN# PTYALL INVALID REMCHR PROBLEM
VERSION 16-2(29) 7-3-72 BY DCS MANY THINGS
VERSION 16-2(28) 6-7-72 BY DCS BUG #HO# RETURN BOTH ADDRESSES FROM ..ARCOP FOR .MES2
VERSION 16-2(27) 5-24-72 BY RHT CHANGE STKUWD TO LOOK AT PPDA
VERSION 16-2(26) 5-15-72 BY JRL ARRPDP BUG AGAIN
VERSION 16-2(24) 5-11-72 BY DCS BUG #HC# BETTER EXPO OUTSTR
VERSION 16-2(23) 5-11-72 BY DCS BUG #HA# IMPRV. ERR. ENB, FIX MUDDY FEET IN EXPO
VERSION 16-2(22) 5-11-72 BY DCS BUG #GT# ALLOW LARGE OCTAL PPNS
VERSION 15-6(17-21) 5-4-72 
VERSION 15-6(17) 3-7-72 BY DCS FIX OUTSTR(NULL) GARBAGING
VERSION 15-6(7-16) 2-20-72 
VERSION 15-6(6) 2-18-72 BY RHT CREATE THE NEW WORLD
VERSION 15-2(5) 2-6-72 BY DCS BUG #FQ# (WD-ARRY)(IN-OUT) WORD COUNT KEPT RIGHT, IOERR OK, DUMP MODE OK
VERSION 15-2(4) 2-5-72 BY DCS BUG #GI# REMOVE TOPSTR
VERSION 15-2(3) 2-1-72 BY DCS BUG #GF# INCHWL BREAKS ON MORE THINGS, TELLS WHAT THEY ARE
VERSION 15-2(2) 1-25-72 BY DCS BUG #GD# Fix non-standard buffer size setup in OPEN
VERSION 15-2(1) 12-2-71 BY DCS INSTALL VERSION NUMBER

⊗;
COMMENT ⊗Indices, Bits for IOSER ⊗
	LSTON	(IOSER)

IFN ALWAYS,<BEGIN IOSER>
DSCR IOSER -- IOSER GENERAL DISCUSSION
 ;SEE GOGOL FOR MORE DETAILS
 ; FORMAT OF CDBs
 DMODE	←← 0	;DATA MODE
 DNAME	←← 1	;DEVICE
 BFHED	←← 2	;HEADER POINTERS
 OBPNT	←← 3	;OUTPUT BUFFER POINTER
 OBP	←← 4	;OUTPUT BYTE POINTER
 OCOWNT	←← 5	;OUTPUT BYTE COUNT
 ONAME	←← 6	;OUTPUT FILE NAME -- FOR INFORMATION ONLY
 OBUF	←← 7	;OUTPUT BUFFER LOCATION
 IBPNT	←←10	;SAME STUFF FOR INPUT
 IBP	←←11
 ICOWNT	←←12
 INAME	←←13
 IBUF	←←14
 ICOUNT	←←15	;INPUT DATA COUNT LIMIT ADDRESS
 BRCHAR	←←16	;XWD TTYDEV FLAG, INPUT BREAK CHAR ADDR
 TTYDEV  ←←16	;LH -1 IF DEVICE IS A TTY -- USED BY OUT
 ENDFL	←←17	;INPUT END OF FILE FLAG ADDR
 ERRTST	←←20	;USER ERROR BITS SPECIFICATION WORD
 LINNUM  ←←21		;ADDR OF LINE NUMBER WORD (SETPL FUNCTION)
 PAGNUM  ←←22		;ADDR OF PAGE NUMBER WORD (SETPL FUNCTION)
 SOSNUM  ←←23		;ADDR OF SOS NUMBER WORD  (SETPL FUNCTION)

 ; SIMIO INDICES

 ?IOSTATUS	←←0
 ?IOIN		←←1	;SEE EXPLANATIONS IN SIMIO ROUTINE
 ?IODIN		←←2
 ?IOOUT		←←3
 ?IODOUT	←←4
 ?IOCLOSE	←←5
 ?IORELEASE	←←6
 ?IOINBUF	←←7
 ?IOOUTBUF	←←10
 ?IOSETI		←←11
 ?IOSETO		←←12
;;%##% A NEW GOODIE
?SETIOSTS	←←13
 ?IOOPEN		←←14
 ?IOLOOKUP	←←15
 ?IOENTER	←←16
 ?IORENAME	←←17
⊗
COMPIL(SIM,<SIMIO,CSERR,LPRYER>,<GOGTAB>
	  ,<SIMIO, CSERR, LPRYER -- SUPPORT ROUTINES>)
COMMENT ⊗Simio, Ioinst, Lpryer, Cserr ⊗

DSCR SIMIO
CAL XCT INDEX,SIMIO
PAR AC field is index into instruction table (see below)
 CHNL contains I/O channel number
 other params can be gleaned from instruction table
RES an I/O instruction is executed. Routine skips if I/O instr did.
 If the INDEX is LEQ 12, and if the instruction skips (error or EOF),
 status is presented in LH of user's EOF vbl (@ENDFL(CDB)), so he
 can test it, or an error message is provided (depending on user-
 enabling). This simplifies many I/O routines.
SID NONE
DES This routine makes I/O instructions re-entrant. The problem is
 that the channel cannot be referenced indirectly.
⊗

↑↑SIMIO:	PUSHJ	P,.+1		;SAVE PC OF XCT
	PUSH	P,C		;SAVE C
	MOVE	C,-1(P)		;ASSUME SKIP RETURN
	LDB	C,[POINT 4,-1(C),12] ;INDEX OF XCT
	JUMPE	C,USTST		;WANT STATUS BITS ONLY
	CAIL	C,13		;NOW SPLIT HIGH AND LOW INDICES
	 JRST	 ALTIO		;SKIP RETURN CHECK ONLY
;;%##% CHECK TO NOT SCREW STANDARD DEC LOSERS
EXPO <
	CAIN	C,IOIN	;
	JRST	ISIOU	;
	CAIE	C,IOOUT	;IN OR OUT ?
	JRST	NOTIOU	;NOPE
ISIOU:	SKIPG	@USBTST(C)	;CHECK FOR NO BUFFERS (& MORE AT CMU)
	JRST	USFUNY		;NO BUFFERS, ETC.
>;EXPO
NOTIOU:MOVE	C,IOINST(C)	;GET INSTRUCTION
	DPB	CHNL,[POINT 4,C,12]	;CHANNEL NUMBER
	XCT	C		;DO OPERATION
	 JRST	 USOUT		;ALL KOSHER, NO EOF OR ERR
USTST:	MOVE	C,[GETSTS C]	;WHA-
	DPB	CHNL,[POINT 4,C,12] ; T HAPPEN-
	XCT	C		;	  ED?
;;%##%	SAVE STATUS BITS
	MOVEM	C,FSTATS(USER)
CMU <
USERF:
>;CMU
	TRZ	C,10000		;IOACT BIT, USER LOOKUP CHECK BIT
	HRLZM	C,@ENDFL(CDB)	;GIVE USER THE BITS
	TDNN	C,ERRTST(CDB)	;ANY HE CAN'T HANDLE?
	JUMPA	CHNL,USSKIP	;NOPE, JUST SKIP-RETURN
;;%CQ% JFR 7-29-75 more information, please
;;	ERR	<I-O DEVICE ERROR ON CHANNEL >,7 ;JUMPA TO PROVIDE CHANNEL AC
	ERRSPL	1,[[ASCIZ /
I-O device error, channel @D status @B   @F: @F  @F/]
		PWORD	CHNL	;CHANNEL #
		PLEFT	@ENDFL(CDB)	;STATUS BITS
		PWORD	DNAME(CDB)	;DEVICE
		PWORD	INAME(CDB)	;INPUT FILE NAME
		PWORD	ONAME(CDB)]	;OUTPUT FILE NAME
;;%CQ% ↑
USSKIP:	AOS	-1(P)		;SKIP-RETURN
USOUT:	POP	P,C		;RESTORE C
	POPJ	P,		;DONE

ALTIO:	MOVE	C,IOINST(C)	;GET INSTR
	DPB	CHNL,[POINT 4,C,12]
	XCT	C		;DO IT
	JRST	USOUT		;NO SKIP
	JRST	USSKIP		;SKIP
EXPO <
USFUNY:	
CMU <	SKIPE	@USBTST(C)	;FUNNY DEVICE?
	JRST	REALTM		; YES.
>;CMU
	JUMP	CHNL,		;FOR THE ERR MSG
	ERR	<NO BUFFERS ASSIGNED FOR I-O CHAN >,7
	JRST	USSKIP
CMU,<	COMMENT ⊗	THIS NONSENSE IS A SPECIAL MODE FOR
	THE CMU SPEECH DEVICES.  ESSENTIALLY, IT DOES EVERTHING
	AS NORMAL, EXCEPT THAT IT PICKS UP THE TIMING ERR AND
	RUN-OUT-OF BUFFERS BIT OF THE
	I/O  STATUS FROM THE STATUS WORD IN THE BUFFER HEADER,
	INSTEAD OF USING THE BIT FROM THE GETSTS.	⊗
TIMERR←←100000		;TIMING ERR BIT FOR SPEECH DEVICES
ROBERR←←200000		;RUN-OUT-OF-BUFFER ERR

REALTM:	PUSH	P,D		;NEED ANOTHER AC
	CAIE	C,IOIN		;INPUTTING?
	JRST	REALOT		; NO
	MOVSI	C,(<IN>)
	DPB	CHNL,[POINT 4,C,12]	;CHAN #
	XCT	C			;DO THE INPUT
	JRST	REALOK			;NO ERR, SO FAR
	MOVE	C,[GETSTS C]	
	DPB	CHNL,[POINT 4,C,12]	;LOOKS FAMILIAR
	XCT	C
	TRZA	C,TIMERR!ROBERR		;TURN OFF THE ONES FROM THE GETSTS
REALOK:	MOVEI	C,0
	HRRZ	D,IBPNT(CDB)		;ADDRESS OF THE NEW BUFFER
	IOR	C,-1(D)			;THE BITS FROM THE BUFFER
REALRT:	POP	P,D			;RESTORE THE AC
	TRNN	C,760000		;ERR OR EOF?
	JRST	USOUT			; NO
	JRST	USERF			; YES, GO LOOK AT IT

REALOT:	MOVE	C,[GETSTS C]
	DPB	CHNL,[POINT 4,C,12]
	XCT	C
	TRNN	C,ROBERR		;STOPPED FOR A ROB?
	JRST	REAL5			; NO
	HRRI	D,(C)			;GET THE BITS
	TRZ	D,760000		;TURN OFF THE ERRS
	HRLI	D,(<SETSTS>)
	DPB	CHNL,[POINT 4,D,12]
	XCT	D
REAL5:	MOVSI	D,(<OUT>)
	DPB	CHNL,[POINT 4,D,12]
	XCT	D
	JRST	REALRT
	JRST	REALRT			;IGNORE NOW, CATCH THE NEXT TIME THRU

>;CMU

USBTST←.-1
	XWD	CDB,IBUF	;1
;;#QY# ! RHT 2-1-74 NEEDED A DUMMY HERE. 
	777777			;@ THRU THIS  WILL BE ILL MEM REF
	XWD	CDB,OBUF	;3
>;EXPO


DSCR INSTRUCTION TABLE
⊗
IOINST←.-1		;IOSTATUS ←← 0  GET STATUS
	IN		;IOIN     ←← 1  BUFFERED INPUT
	IN D		;IODIN	  ←← 2  DUMP MODE INPUT
	OUT		;IOOUT	  ←← 3  BUFFERED OUTPUT
	OUT D		;IODOUT	  ←← 4  DUMP MODE OUTPUT
	CLOSE (D)	;IOCLOSE  ←← 5  CLOSE I,O, OR BOTH
;; ALLOW USE OF INHIBIT BITS IN RELEASE
	RELEASE	(D)	;IORELEASE←← 6
	INBUF (A)	;IOINBUF  ←← 7
	OUTBUF (A)	;IOOUTBUF ←←10
	USETI (A)	;IOSETI	  ←←11
	USETO (A)	;IOSETO	  ←←12
;;%##% A NEW GOODIE
	SETSTS  (A)	; SET IO STATUS
	OPEN DMODE(CDB)	  ;IOOPEN	  ←←14
	LOOKUP FNAME(USER);IOLOOKUP←←15
	ENTER FNAME(USER);IOENTER  ←←16
	RENAME FNAME(USER);IORENAME←←17

HACK <

;; ****** these two routines are badly misplaced
;; they ought to be removed from this compil someday
;; check with Bob Smith first, though
>;HACK

HERE(CSERR)	MOVE	USER,GOGTAB
	POP	P,UUO1(USER)	;STANDARD PLACE
	ERR	<CASE INDEX OVERFLOW, VALUE IS >,13
	JRST	@UUO1(USER)	;RETURN OK

HERE (LPRYER) ERR	<DATUM OF ARRAY NOT THERE>,1
	POPJ	P,

ENDCOM(SAV)
COMPIL(CHN,<GETCHN,NOTOPN,GETCHAN>,<GOGTAB>,<GETCHN, NOTOPN, GETCHAN>)
COMMENT ⊗Getchn ⊗

DSCR Getchn, Getchan

PAR A -- addr of ASCII for routine name
 CHNL -- I/O channel number from SAIL call
RES -- CHNL contains actual I/O channel number (diff for shared TTY)
 CDB contains ptr to  actual CDB table for that channel
SID A(lh) is changed
DES normally just sets up CHNL and CDB
 if error occurs (channel out of bounds, already open), a fatal message
  is printed, using the address in A to get the routine name.
 This routine is called by most I/O routines, having saved ACs and 
  fetched CHNL.
⊗

GETCHN:
	HRLI	A,(<PUUO 3,0>)	;PREPARE FOR ERR MESS
	TRZE	CHNL,777760	;CHECK FOR VALID CHANNEL NO
	 JRST	 NOTVALID	;INVALID CHANNEL NUMBER
	SKIPE	CDB,@CDBLOC(USER) ;IS CHANNEL OPEN? (CDBLOC SET BY ALLOC)
	POPJ	P,

NOTOPN:	
	XCT	A		;PRINT ROUTINE NAME
	ERR	<: CHANNEL OR FILE NOT OPEN>


NOTVALID:
	XCT	A		;ROUTINE NAME
	ERR	<: CHANNEL NUMBER INVALID>


DSCR INTEGER←GETCHAN;
CAL SAIL
⊗

HERE (GETCHAN)
	MOVE	USER,GOGTAB
	ADD	USER,[XWD A,CHANS]	;MAKE @ WORD
	MOVEI	A,1			;START AT CHANNEL 1
CHLUP:	SKIPN	@USER			;IF CHANNEL IS FREE,
	POPJ	P,			; RETURN
	CAIGE	A,17			;CYCLE TO 0?
	AOJA	A,CHLUP			;NO, TRY NEXT
	MOVEI	A,0			;TRY 0
	SKIPE	@USER			;FREE?
	HRROI	A,-1			;NOPE
	POPJ	P,			;DONE

ENDCOM(CHN)
COMPIL(FIL,<FILNAM>,<FLSCAN,X22>,<FILNAM SCANNING ROUTINE>)
COMMENT ⊗Filnam ⊗

DSCR FILNAM
CAL PUSHJ
PAR file name string on SP stack
 of form FILENAME<.EXT><[PROJ,PROG]>
RES FNAME(USER) : SIXBIT /filename/
 EXT(USER): SIXBIT /extension,,0/
 0
 PRPN(USER): SIXBIT /PRJ PRG/ (or zero)
SID uses D,X,Y (4-6), REMOVES STRING FROM STACK
***** SKIP RETURNS IF SUCCESSFUL *****
⊗

↑↑FILNAM:
	SUB	SP,X22		;ADJUST STACK
	FOR II←1,3 <
	SETZM	FNAME+II(USER)>
	MOVEI	X,FNAME(USER)	;WHERE TO PUT IT
	PUSHJ	P,FLSCAN	;GET FILE NAME
	JUMPE	Y,FLDUN	;FILE NAME ONLY
	CAIE	Y,"."		;EXTENSION?
	JRST	FLEXT		;NO, CHECK PPN
	MOVEI	X,FNAME+1(USER)
	PUSHJ	P,FLSCAN
FLEXT:	JUMPE	Y,FLDUN	;NO PPN SPECIFIED
	CAIE	Y,"["
	JRST	FLERR		;INVALID CHARACTER
CMU <		;HANDLE PPNS VIA UUO, MAYBE
	HRRZS	1(SP)	;LENGTH PART
		;SNEAK A LOOK AT FIRST CHAR
	SKIPN	1(SP)	;IS THERE A FIRST CHAR?
	JRST	FLERR	; NO.
	MOVE	X,2(SP)
	ILDB	X,X
;;=C4= 1 of several LDE 28-Jun-74	allow null ppn within [].
	CAIN	X,"]"		;is it null?
	JRST	OCTPPN		; yes -- let the other guy handle it.
;;
	CAIL	X,"0"
	CAILE	X,"7"
	SKIPA		; NOT OCTAL DIGIT
	JRST	OCTPPN
	PUSH	P,A	;NEED MORE ROOM
	PUSH	P,B
	SETZM	A	;CLEAR THE AREA
	SETZM	B
	SETZM	C
	MOVEI	D,=13+1	;MAX #CHARS+1
	MOVE	X,[POINT 7,A]	;DUMP THEM THERE
FLN2:	SOSGE	1(SP)
	JRST	FLERRC	;RAN OUT OF STRING
	ILDB	Y,2(SP)	;THE NEXT CHAR
;;=C4= 2 OF SEVERAL
	JUMPE	Y,FLN2	;IGNORE NULLS
;;
	CAIN	Y,"]"	;THE END?
	JRST	GOTRB	; YES
	JUMPLE	D,FLERRC	;WE DON'T WANT ANY MORE CHARACTERS
	IDPB	Y,X	;STICK THE CHAR THERE
	SOJA	D,FLN2	;GET ANOTHER

GOTRB:	MOVEI	X,A	;THATS WHERE THE UUO WILL FIND THEM
	CALLI	X,-2		;CMUDEC UUO
	JRST	FLERRC	;SOMETHING WRONG
	MOVEM	X,FNAME+3(USER)	;SAVE IT

	AOS	-2(P)		;INDICATE SUCCESS
FLERRC:	POP	P,B
	POP	P,A
	POPJ	P,
OCTPPN:
>;CMU
	PUSHJ	P,[

	RJUST:	SETZM	PROJ(USER)
		MOVEI	X,PROJ(USER)
		PUSHJ	P,FLSCAN	;GET PROJ OR PROG IN SIXBIT
IFN SIXSW,<
		MOVE	X,PROJ(USER)
		IMULI	D,-6		;SHIFT FACTOR
		LSH	X,(D)		;RIGHT-JUSTIFY THE PROJ OR PROG
>;IF SIXSW (SET IN HEAD, USUALLY CONDITIONED ON NOEXPO)
	
IFE SIXSW,<
		MOVEI	X,0
;;#GT# DCS 5-11-72 ALLOW LARGE OCTAL NUMBERS AT STD DEC SYSTEMS
;;=C4= 3 OF several LE03 28-JUN-74	ALLOW NULL PPN
;		MOVE	D,PROJ(USER)	;WAS A HLLZ
		SKIPN	D,PROJ(USER)
		POPJ	P,
;;
;;
	FBACK:	MOVEI	C,0
		LSHC	C,6		;GET A SIXBIT CHAR
		CAIL	C,'0'
		CAILE	C,'7'
		JRST	FLERR		;INVALID OCTAL
		LSH	X,3
		IORI	X,-'0'(C)
		JUMPN	D,FBACK
>;NOT SIXSW (USUALLY CONDITIONED ON EXPO)
	FPOP:	POPJ	P,]

	HRLZM	X,FNAME+3(USER)
	CAIE	Y,","
;;=C4 4 OF several
;	JRST	FLERR		;INVALID CHAR
	JRST	[JUMPE	X,FLDUN1	;ALLOW NULL PPN - CHECK FOR "]"
		 JRST	FLERR]		;A REAL ERROR.
;;
	PUSHJ	P,RJUST		;JUSTIFY(AND CONVERT IF EXPORT) PROG #
	HRRM	X,FNAME+3(USER)
;;=C4= 5 OF several.
FLDUN1:
;;
	CAIN	Y,"]"
FLDUN:	AOS	(P)		;SUCCESSFUL
FLERR:	POPJ	P,		;DONE, NOT NECESSARILY RIGHT

ENDCOM(FIL)
COMPIL(FLS,<FLSCAN>,,<FLSCAN ROUTINE>)
COMMENT ⊗Flscan ⊗

DSCR FLSCAN
CAL PUSHJ
PAR X -- addr of destination SIXBIT
 1(SP), 2(SP) -- input string
RES sixbit for next filename, etc in word addressed by X
 break (punctuation) char in Y (0 if string exhausted)
 D,X, input string adjusted
SID only those AC changes listed above (Y, for instance)
⊗

↑↑FLSCAN:  
	HRRZS	1(SP)		;WANT ONLY LENGTH PART
	MOVEI	D,6		;MAX NUMBER PICKED UP
	SETZM	(X)		;ZERO DESTINATION
	HRLI	X,440600	;BYTE POINTER NOW
FLN1:	MOVEI	Y,0		;ASSUME NO STRING LEFT
	SOSGE	1(SP)		;TEST 0-LENGTH STRING
	 POPJ	 P,
	ILDB	Y,2(SP)		;GET BYTE
	CAIE	Y,"."		;CHECK VALID BREAK CHAR
	CAIN	Y,"["
	POPJ	P,
	CAIE	Y,"]"
	CAIN	Y,","
	POPJ	P,
	JUMPE	D,FLN1		;NEED NO MORE CHARS
;;=C4=	6 of several.	IGNORE NULL CHARACTERS.
	JUMPE	Y,FLN2X
;;
	TRZN	Y,100		;MOVE 100 BIT TO 40 BIT
	TRZA	Y,40		; TO CONVERT TO SIXBIT
	TRO	Y,40		; (NO CHECKING)
	IDPB	Y,X		;PUT IT AWAY
;;=C4= 7 of several
FLN2X:
;;
	SOJA	D,FLN1		;CONTINUE

ENDCOM(FLS)
COMPIL(OPN,<OPEN,RELEASE,SETPL,CHNCDB>
	  ,<GETCHN,SAVE,RESTR,CORGET,FLSCAN,SIMIO,X33,X22,X11,CORREL>
	  ,<OPEN RELEASE AND SETPL FUNCTIONS>)

COMMENT ⊗Open ⊗

DSCR OPEN(CHAN,"DEV",MODE,IBFS,OBFS,@INCNT,@INBRCHR,@INEOF);
CAL SAIL
⊗
COMMENT ⊗
Allocate IBFS input and OBFS output buffers on channel CHAN for
 device DEV(SAIL/GOGOL string). Store INCNT, and the INBCHR and INEOF 
 addresses in a newly allocated CDB (channel data block). Store 
 all necessary information to carry out I/O on this channel
 in the CDB. Mark the channel open.
⊗

.OPN:
HERE (OPEN)
; FIRST RELEASE IF ALREADY OPEN
	PUSH	P,-7(P)
; RELEAS NOW TAKES TWO ARGS
	PUSH	P,[0]
	PUSHJ	P,RELEASE	;SIMPLE

; NEXT SAVE AC'S, SET UP USER REGISTER, OBTAIN A CDB

	PUSHJ	P,SAVE		;SAVE ACS
	MOVEI	C,IOTLEN	;SIZE
	PUSHJ	P,CORGET	;OBTAIN A BLOCK
	 JRST	 BADOPN		;CAN'T GET IT
	MOVE	CDB,B		;CDB ptr to CHANNEL TABLE
	MOVEI	LPSA,0		;NOW GET READY IN CASE OF ERROR
	SUB	SP,X22

; FILL IT WITH NON-CONTROVERSIAL THINGS

	POP	P,TEMP		;RETURN ADDRESS
	POP	P,ENDFL(CDB)	;END OF FILE FLAG ADDRESS
	POP	P,BRCHAR(CDB)	;BREAK CHAR ADDRESS
	POP	P,ICOUNT(CDB)	;INPUT COUNT ADDRESS
	POP	P,OBUF(CDB)	;NUMBER OF OUTPUT BUFFERS
	POP	P,IBUF(CDB)	;NUMBER OF INPUT BUFFERS
	POP	P,Z		;DATA MODE
	POP	P,CHNL		;DATA CHANNEL
;; #RX# (CMU = B7=)INITIALIZE SOSNUM AND FRIENDS
	SETZM	LINNUM(CDB)
	SETZM	SOSNUM(CDB)
	SETZM	PAGNUM(CDB)
;; #RX#
	CHKCHN	CHNL,<OPEN>	;ASSURE VALID
;;#HA# DCS 5-11-72 IMPROVE ERROR ENABLE. ALSO, IN EXPO SYSTEM,
;;		   AVOID REFERENCES TO PGNNO, WHICH IS same as ERRTST!
	HRRZI	X,750000	;ERROR BITS POSSIBLY ENABLED  -- WAS A HRROI
;;#HA#
	ANDCM	X,Z		;ERROR BITS ACTUALLY ENABLED ARE 0
	MOVEM	X,ERRTST(CDB)	;SAVE ENABLATIONS
	TRZ	Z,750000	;REMOVE IRRELEVANT BITS
ILLMOD ←← 777777
CMU <
ILLMOD ←← 377776		;BIT 400000 FOR SPECIAL DEVICE (CMU)
				;BIT 000001 FOR KEEPING NULLS
	TLZE	Z,10000	;IOACTIVE BIT TO BE SET ON OPEN ??? (LDE)
	TRO	Z,10000	;YES
>;CMU
	TLNE	Z,ILLMOD	;CHECK VALIDITY SOMEWHAT
	 ERR	 <OPEN: INVALID DATA MODE>,1
	MOVEM	Z,DMODE(CDB)	;STORE MODE

; GET DEVICE NAME

	MOVEI	X,DNAME(CDB) ;WHERE SIXBIT'S TO GO
	PUSHJ	P,FLSCAN	;GET DEVICE NAME
;;%##% ONLY GIVE ERROR MESSAGE IF NOT ASKED NOT TO
	JUMPN	Y,[
		SKIPN	@ENDFL(CDB)	;FLAGGED??
		ERR	<INVALID DEVICE NAME FOR OPEN>,1
		JRST	.+1
		]

;IF TTY, MARK TTYDEV FOR OUT

	HLRZ	TEMP,DNAME(CDB)	;GET LH DEVICE NAME
	MOVSI	Z,400000	;BIT TO MARK WITH
;;%##% DO A DEVCHR NOW
;;	CAIE	TEMP,'TTY'	;IF TTY OR PTY,
	CAIN	TEMP,'PTY'	; ,
	JRST	MRKTYB		;MARK AS A TTY
	MOVE	TEMP,DNAME(CDB)	;PICK UP DEVICE AGAIN (FULL SIXBIT)
	CALL6	(TEMP,DEVCHR)	;GET CHARACTERISTICS
	TLNE	TEMP,10		;A TTY???
MRKTYB:	 IORM	 Z,TTYDEV(CDB); IT'S A TTY
;;%##%

; NOW SET HEADER PTRS IN CDB

	HRRZI	Z,-1		;TO TEST RIGHT HALF
	SETZM	BFHED(CDB)	;CLEAR HEADER POINTER
	LDB	E,[POINT 4,DMODE(CDB),35] ;DATA MODE
	CAIL	E,15		;DUMP MODE?
	 JRST	 AGNN		; YES, NO BUFFER HEADER WORD
	MOVEI	TEMP,OBPNT(CDB)	;IF OUTPUT, SET POINTER
	TDNE	Z,OBUF(CDB)	;ANY OUTPUT BUFFERS?
	 HRLM	 TEMP,BFHED(CDB)
	MOVEI	TEMP,IBPNT(CDB)	;SAME FOR INPUT
	TDNE	Z,IBUF(CDB)	;ANY INPUT BUFFERS?
	 HRRM	 TEMP,BFHED(CDB)

; NOW OPEN THE FILE, GET THE BUFFERS,ETC.

AGNN:	XCT	IOOPEN,SIMIO		; OPEN CHAN,MODE
	 JRST	 [SKIPE @ENDFL(CDB) ;DOES USER WANT TO KNOW?
			 JRST	NORELO ;YES, RELEASE CDB, ERASE ALL OF ATTEMPT
			 JRST	RTRY]

COMMENT ⊗
ERMAN'S IMPROVED BUFFER GETTER   ---  DEC. 1970
 If a buffer size is specified (lh #buf word), allocate that size, else the
standard size (determined via a dummy XXXBUF, clever soul that LDE is).
"NOTICE WITH AWE THAT NO CORE IS EVER WASTED, AS IN THE INFERIOR OLD WAY" (sic).
⊗
	MOVEI	Z,0		;FOR DUMMY (AND REAL) OUTBUF
	PUSHJ	P,GETBFS	;GET CORE, DO THE OUTBUFS (OR SIMULATIONS)
	ADDI	CDB,OBUF-OBPNT+1 ;RELOCATE FOR INPUT IN CDB
	MOVEI	Z,-1
	PUSHJ	P,GETBFS	;GET CORE, DO INBUFS
	SUBI	CDB,OBUF-OBPNT+1;RE-RELOCATE
CMU <	;FUNNY INPUT DEVICE
	SKIPL	DMODE(CDB)		;DID HE SPECIFY TO GET ERRS FROM
					; BUFFER HEADER?
	JRST	STNIT			;     NO.
	HRLZI	TEMP,400000
	SKIPE	IBUF(CDB)		;INPUT BUFFERS?
	JRST	[IORM	TEMP,IBUF(CDB)	; YES
		 JRST	STNIT]
	SKIPE	OBUF(CDB)		;OR OUTPUT BUFFERS?
	JUMPA	CHNL,[IORM	TEMP,OBUF(CDB)	; YES
			JRST	STNIT]
	ERR<OPEN: SPEECH DEV BUT NO BUFFERS, CHAN >,7
>;CMU

; FINISH OUT -- SET EOF FLAG IF DESIRED

STNIT:	;SETOM	JOBFF		;ONE MUST KNOW WHAT HE IS DOING TO USE
	MOVEM	CDB,@CDBLOC(USER) ;STORE CDB ADDR IN CHANS TABLE
	SETZM	@ENDFL(CDB)	;MARK OPEN SUCCESSFUL
	JRST	RESTR		;RESTORE ACS, RETURN

BADOPN:	HRRZ	TEMP,JOBREN	;NEXT START WILL ASK ALLOC
	HRRM	TEMP,JOBSA	;QUESTION
	ERR	<TOO MANY CHANNELS OR I/O BUFFERS REQUESTED>,1,<(TEMP)>

RTRY:	TERPRI	<OPEN: DEVICE NOT AVAILABLE>
	TERPRI	<TYPE "R" TO RETRY, "X" TO GO ON WITHOUT>
	PRINT	<?>
	PUUO	TEMP
	CAIE	TEMP,"r"
	CAIN	TEMP,"R"	;TRY AGAIN?
	 JRST	 AGNN		;YES
;;%##%
	SETOM	@ENDFL(CDB)	;MARK A LOSER
	JRST	 NORELO
;;%##%

GETBFS:	SETZM	ONAME(CDB)	;CLEAR FILE NAME
	HRRZ	Y,OBUF(CDB)	;NUMBER OF BUFFERS
	HLRZ	D,OBUF(CDB)	;SIZE
EXPO <
	HRRZS	OBUF(CDB)	;MARK FOR SPECIAL TEST
>;EXPO
	JUMPE	Y,GBUFRT	;NO BUFFERS
	JUMPE	D,GETDES	;WANTS DEFAULT SIZE
	ANDI	D,7777		;MAX BUFFER SIZE
	HRLZ	A,D		;SIZE IN LH
	PUSHJ	P,GETCOR	;GET THE CORE (SURPRISE!)
	SETZM	OCOWNT(CDB)	;IN CASE NO ACTUAL INBUF (OUTBUF) DONE
	CAIL	E,15		;DUMP MODE?
	 JRST	 GBUFRT		; YES, DON'T ACTUALLY FUDGE UP BUFFERS
NOEXPO <;USE UINBF, UOUTBF
;;#GD# 01-25-72 DCS (1-2) set up JOBFF, Fix XCT, bad count
	MOVEM	B,JOBFF		;B FROM CORGET HAS BUFFER AREA ADDRESS
	SUBI	D,2		;GETCOR INCREMENTED
;;#GD#
	HRRZ	C,Y
	MOVE	A,[UINBF C]
	JUMPN	Z,.+2
	MOVE	A,[UOUTBF C]
	DPB	CHNL,[POINT 4,A,12]
;;#GD# 01-25-72 DCS (2-2) (was XCT CHNL, clearly wrong)
	XCT	A		;DO THE ALLOCATIONS
;;#GD#
	POPJ	P,
>;NOEXPO
EXPO <
	ADDI	B,1		;SECOND WORD
BUFC1:	HRR	A,B
	SOJLE	Y,BUFC2
	ADD	B,D		;NEXT ONE
	MOVEM	A,(B)		;MAKE POINT TO PREV
	JRST	BUFC1

BUFC2:	MOVE	B,OBUF(CDB)	;BACK TO FIRST
	MOVEM	A,1(B)		;LINK IT TOO
	HRLI	A,400000	;RING-USE BIQ
	MOVEM	A,OBPNT(CDB)	;BUFFER PTR
	POPJ	P,
>;EXPO

GETCOR:	ADDI	D,2		;+2 FOR ACCOUNTING
	MOVE	C,D
	IMUL	C,Y		;TOTAL CORE NEEDED
	PUSHJ	P,CORGET	;GRAB IT
	ERR	<OPEN: NOT ENUFF CORE FOR BUFFERS>
	HRRZM	B,OBUF(CDB)	;SAVE SO CAN RELEASE
	POPJ	P,

GETDES:	MOVEI	A,1		;1 DUMMY BUFFER
	CAIL	E,15		;GOOD OLD DUMP MODE?
	 JRST	 [MOVEI D,202	;ASSUME THIS, SINCE INBUF/OUTBUF WON'T
		  JRST GDIT]	; WORK IN DUMP MODE
;;#VE# UGLY CODE REPLACED BY DIFFERENT UGLY CODE
;	MOVEI	TEMP,BRKDUM-1(USER)
;	MOVEM	TEMP,JOBFF
	PUSH	P,[0]		;
	HRRZM	P,JOBFF		;
	PUSH	P,[0]		;MOST LIKEYL ONLY ONE PUSH IS ENOUGH, BUT ...
	PUSH	P,[0]		;
	PUSHJ	P,GETIOB	;DUMMY IN/OUBUF
	LDB	D,[POINT 17,-1(P),17] ;GET THE SIZE
	SUB	P,X33		;POP BACK
;;#VE# ↑↑
GDIT:	PUSHJ	P,GETCOR	;GET THE CORE
	SETZM	OCOWNT(CDB)	;CLEAR BYTE COUNT
	CAIL	E,15		;DUMP MODE?
	JRST	GBUFRT		;YES, NO BUFFER STRUCTURE
	MOVEM	B,JOBFF
	MOVE	A,Y		;NUMBER OF BUFFERS
	PUSHJ	P,GETIOB	;NOW FOR REAL
GBUFRT:	SETOM	JOBFF		;FOR SPITE
	POPJ	P,

GETIOB:	SKIPN	Z
	XCT	IOOUTBUF,SIMIO	;DO OUTBUF
	SKIPE	Z
	XCT	IOINBUF,SIMIO	;INBUF
	POPJ	P,
SUBTTL	RELEASE
COMMENT ⊗Release ⊗

DSCR RELEASE(CHANNEL NO,INHIBIT BITS);
CAL SAIL
DES THIS USES THE DEFAULT PARAMETER MECHANISM, 0 DEFAULT FOR INHIBIT BITS
⊗

COMMENT ⊗
Release channel, i/o buffers, channel table if channel is open
Adjust special TTY stuff to reflect lossage if TTY channel
⊗


HERE(RELEASE)
.RELS:
	SETOM	JOBFF		;MARK INVALID
	PUSHJ	P,SAVE		;SAVE REGS, GET USER, SAVE RETURN
;; FOLLOWING WAS MOVE LPSA,X22
	MOVE	LPSA,X33
;; FOLOWING WAS CHNL,-1(P)
	MOVE	CHNL,-2(P)	;CHANNEL #
	CHKCHN	CHNL,<RELEASE> ;VALIDATE
	SKIPN	CDB,@CDBLOC(USER) ;GET ADDR FROM CHANS TABLE-- CHANNEL OPEN?
	 JRST	 RESTR		;CHANNEL NOT OPEN, FORGET IT
	SETZM	@CDBLOC(USER)	;CLEAR CHANS TABLE ENTRY
;; INHIBIT BITS;
	HRRZ	D,-1(P)		;THE DEFAULT OR USER SPECIFIED INHIBIT BITS
	XCT	IORELEASE,SIMIO	;RELEASE CHAN,0
	HRRZ	B,IBUF(CDB)	;RELEASE ANY INPUT
	PUSHJ	P,BUFREL	; BUFFERS
	HRRZ	B,OBUF(CDB)	;ALSO OUTPUT
	PUSHJ	P,BUFREL	; BUFFERS
NORELO:	HRRZ	B,CDB		;WHERE TO RELEASE
	PUSHJ	P,CORREL	;GIVE CDB BACK
	JRST	RESTR		;RESTORE AND RETURN

BUFREL:	JUMPN	B,CORREL	;RELEASE IF ANY TO RELEASE
	POPJ	P,		;ELSE RETURN


DSCR SETPL(CHANNEL,@LINNUM,@PAGNUM,@SOSNUM)
CAL SAIL
⊗

HERE(SETPL)
	PUSHJ	P,SAVE
	MOVE	CHNL,-4(P)	;GET CHANNEL
	PUSHJ	P,GETCHN	;VALIDATE, LOAD CDB
	POP	P,TEMP		;RETURN ADDRESS (GET OUT OF WAY)
	POP	P,SOSNUM(CDB)
	SETZM	@SOSNUM(CDB)
	POP	P,PAGNUM(CDB)
	SETZM	@PAGNUM(CDB)
	POP	P,LINNUM(CDB)	;LINE NUMBER
	SETZM	@LINNUM(CDB)
	MOVE	LPSA,X11	;REMOVE CHANNEL NUMBER FROM STACK
	JRST	RESTR

;;%AV% -- rht
DSCR CHNCDB(CHANNEL);
CAL SAIL
DES RETURNS INTEGER = INPHDR,,OUTHDR
	(ACTUALLY COULD BE GOTTEN FROM CDB BY USER, BUT THIS
	PROMISSES MORE STABILITY)
⊗

HERE(CHNCDB)
	PUSHJ	P,SAVE		;
	MOVE	CHNL,-1(P)	;GET CHANNEL NUMBER
	PUSHJ	P,GETCHN	;CHECK & LOAD CDB
	MOVEI	1,DMODE(CDB)	;GET VALUE
	MOVEM	1,RACS+1(USER)	;SO RESTR WINS
	MOVE	LPSA,X22	;
	JRST RESTR		;RETURN

HERE(OPNSP1)			;PERHAPS PUT GETSTS HERE
;;%##% GOBBLED DOWN TWO SPARE HERES HERE FOR STATUS ROUTINES THAT FOLLOW
	ERR <DRYROT IN OPEN SPARES>

ENDCOM (OPN)
;;%##%
COMPIL(STS,<GETSTS,SETSTS>
	,<SAVE,RESTR,SIMIO,GOGTAB,GETCHN,X11,X33,X22>
	,<GETSTS AND SETSTS>)


COMMENT ⊗GETSTS,SETSTS⊗

DSCR STATUS←GETSTS(CHANNEL);
CAL SAIL
⊗

.STS:
HERE(GETSTS)
	PUSHJ	P,SAVE
	LOADI7	A,<GETSTS>
	MOVE	CHNL,-1(P)	;CHANNEL #
	PUSHJ	P,GETCHN
	XCT	IOSTATUS,SIMIO	;DO THE UUO
	JFCL
	MOVE	A,FSTATS(USER)	;THE RESULT
	MOVEM	A,RACS+A(USER)	;SO RESTR WORKS
	MOVE	LPSA,X22
	JRST	RESTR

DSCR SETSTS(CHANNEL,STATURS);
CAL SAIL
⊗

HERE(SETSTS)
	PUSHJ	P,SAVE
	LOADI7	A,<SETSTS>
	MOVE	CHNL,-2(P)
	PUSHJ	P,GETCHN
	MOVE	A,-1(P)		;INTENDED STATUS BITS
	XCT	SETIOSTS,SIMIO	;XECUTE THE INST
	JFCL			;SHOULDN'T SKIP
	MOVE	LPSA,X33
	JRST	RESTR		;GO RESTORE

ENDCOM(STS)
COMPIL(LOK,<LOOKUP,ENTER,FILEINFO>
	  ,<SAVE,RESTR,GETCHN,FILNAM,SIMIO,X33,X22,GOGTAB>
	  ,<LOOKUP, ENTER, AND FILEINFO ROUTINES>)
COMMENT ⊗Lookup, Enter ⊗

DSCR LOOKUP(CHANNEL,"FILE NAME",@FAILURE FLAG);
CAL SAIL
⊗

Comment ⊗
LOOKUP or ENTER file FILENAME on channel CHANNEL, where FILENAME has
	a format acceptable to FILNAM above. If successful,
	FAILURE!FLAG (called by reference) is zeroed. It is
	otherwise set to -1 in LH, error code in RH.
⊗


.LOK:
HERE (LOOKUP) PUSHJ	P,SAVE
	LOADI7	A,<LOOKUP>
	PUSH	P,[XCT	IOLOOKUP,SIMIO]	;LOOKUP CH,FILE
	MOVEI	B,INAME			;TO STORE FILE NAME
	JRST	LOKENT			;DO THE OPERATION

DSCR ENTER(CHANNEL,"FILE NAME",@FAILURE FLAG);
CAL SAIL
⊗

HERE (ENTER)
	PUSHJ	P,SAVE
	LOADI7	A,<ENTER>
	PUSH	P,[XCT IOENTER,SIMIO]	;ENTER CH,FILE
	MOVEI	B,ONAME			;TO STORE FILE NAME
LOKENT:
	MOVE	LPSA,X33		;PARAM ADJUST FOR RESTR
	MOVE	CHNL,-3(P)		;GET CHANNEL #
	PUSHJ	P,GETCHN		;VALIDATE
	SETZM	@-2(P)			;ASSUME SUCCESS
	PUSHJ	P,FILNAM		;GET FILE
	 JRST	 BADSPC			; NO GOOD, REPORT ERROR
	ADD	B,CDB			;ADDR OF FILE NAME HOLDER
	MOVEW	(<(B)>,<FNAME(USER)>)	;STORE IT
	POP	P,X			;INSTRUCTION TO DO
	MOVE	Y,[JRST ELERR]		;FAILURE
	MOVE	Z,[JRST RESTR]		;SUCCESS
ENF1:	JRST	X			;ENTER/LOOKUP

BADSPC:	POP	P,(P)			;REMOVE IO INSTRUCTION
	HRRZ	TEMP,ERRTST(CDB)	;GET USER-ENABLE BITS
	TRNE	TEMP,10000		;ENABLED FOR HANDLING BAD FILE SPECS?
	ERR	<LOOKUP OR ENTER: INVALID FILE SPECIFICATION>,1 ;NO, TELL HIM
	SKIPA	TEMP,[=8]		;ALWAYS REPORT NO GOOD LOOKUP/ENTER
ELERR:	HRRZ	TEMP,FNAME+1(USER)	;WHY DID IT BLOW?
	HRROM	TEMP,@-1(P)		;TELL THE USER
	JRST	RESTR
COMMENT ⊗Fileinfo ⊗

DSCR FILEINFO(INTEGER ARRAY INFO[1:6]);
CAL SAIL
⊗

Comment ⊗ This routine gives the user the entire 6 word block
  from the last LOOKUP, ENTER, or RENAME operation done by SAIL.⊗

HERE (FILEINFO)
	MOVE	USER,GOGTAB
	POP	P,UUO1(USER)		;GET RID OF IT, MARK LAST SAIL CALL
	POP	P,LPSA			;ARRAY ADDRESS WHERE INFO IS TO GO
	SKIPGE	-2(LPSA)		;MAKE SURE IT'S NOT A STRING ARRAY
	 ERR	 <PASS 6 WORD INTEGER VECTOR TO FILEINFO>,1
	MOVE	TEMP,-1(LPSA)		;TOTAL ARRAY SIZE WORD
	CAML	TEMP,[XWD 1,6]		;MUST BE 1-D, AT LEAST 6 WORDS
	CAMLE	TEMP,[XWD 1,-1]		;BUT NOT 2-D
	 ERR	 <PASS 6 WORD INTEGER VECTOR TO FILEINFO>,1
	MOVEI	TEMP,5(LPSA)		;BLT TERMINATOR
	HRLI	LPSA,FNAME(USER)	;SOURCE OF VALUABLE INFORMATION
	BLT	LPSA,(TEMP)		;GIVE!
	JRST	@UUO1(USER)		;GONE

ENDCOM (LOK)
COMPIL(OUT,<OUT>,<SAVE,RESTR,GETCHN,SIMIO,NOTOPN,X11,X22>
	  ,<STRING OUTPUT ROUTINE>)
COMMENT ⊗Out ⊗

DSCR OUT(CHANNEL,"STRING");
CAL SAIL
⊗
COMMENT ⊗
Simply places all characters of string in output buffer for channel.
Close file if device is TTY    ⊗

.OUT.:
HERE (OUT)	PUSHJ	P,SAVE		;ACS, GET USER, SAVE RETURN FOR ERROR
	MOVE	LPSA,X22
	MOVE	CHNL,-1(P)	;CHANNEL NUMBER
	LOADI7	A,<OUT>
	PUSHJ	P,GETCHN	;VALIDATE AND GET CDB, ETC.
	HRRE	Z,-1(SP)	;#CHARS
	POP	SP,D
	SUB	SP,X11
	MOVE	B,OBP(CDB)
	MOVE	A,OCOWNT(CDB)
	JRST	.OUT1


.OUT:	SOJLE	A,OUT1		;NEED OUTPUT??
.OUT2:	ILDB	X,D		;GET A CHAR
	IDPB	X,B		;PUT IT AWAY
.OUT1:	SOJGE	Z,.OUT		;LOOP
OUTDUN:	MOVEM	B,OBP(CDB)	;PUT BP AWAY
	MOVEM	A,OCOWNT(CDB)	;COUNT AWAY
	SKIPGE	TTYDEV(CDB)	;TTY?
	XCT	IOOUT,SIMIO	; YES, FORCE OUTPUT
	JRST	RESTR
	JRST	RESTR

OUT1:	LDB	TEMP,[POINT 4,DMODE(CDB),35] ;MODE
	CAIL	TEMP,15		;DUMP?
	 JRST	 DMPO		;YES
	MOVEM	B,OBP(CDB)	;PUT REAL BP AWAY
	XCT	IOOUT,SIMIO	;DO THE OUTPUT
	JFCL			;ERRORS HANDLED IN SIMIO
	MOVE	B,OBP(CDB)	;NEW BP
	MOVE	A,OCOWNT(CDB)	;NEW COUNT
	JRST	.OUT2		;CONTINUE

; SPECIAL DUMP-MODE OUTPUT STUFF

DMPO:	PUSH	P,D
	HRRZ	D,OBUF(CDB)	;PTR TO BUFFER AREA
	SUBI	D,1		;ADDR-1 FOR IOWD
	HRLI	D,-=128		;-WORD COUNT
	MOVEI	D+1,0
	XCT	IODOUT,SIMIO	;OUT D,
	JFCL			;ERRORS HANDLED IN SIMIO
OKO:	HRRZ	B,D		;SAVE ADDR
	HRLI	D,1(D)		;BLT WORD
	HRRI	D,2(D)
	SETZM	-1(D)
	BLT	D,=128(B)	;CLEAR BUFFER
	POP	P,D		;RESTORE INPUT BYTE POINTER
	AOS	@ENDFL(CDB)	;SPECIAL TREATMENT
	HRLI	B,700		;POINT 7,-1(1ST WORD),35
	MOVEM	B,OBP(CDB)
	MOVEI	A,5*=128	;CHAR COUNT
	MOVEM	A,OCOWNT(CDB)
	JRST	.OUT2		;AFTER OUTPUT SIMULATION, GO ON

ENDCOM(OUT)
COMPIL(INP,<INPUT>
	  ,<SAVE,.SKIP.,INSET,RESTR,SIMIO,GETCHN,STRNGC,BRKMSK,BKTCHK,X33,NOTOPN,GOGTAB
>
	  ,<STRING INPUT ROUTINE>)
COMMENT ⊗Input ⊗

DSCR  "STRING"←INPUT(CHANNEL,BREAK TABLE NUMBER);
CAL SAIL
SID NO ACS SAVED BY INPUT!!!!!!
⊗

.IN.:
HERE (INPUT)	
	MOVE	USER,GOGTAB	;GET TABLE POINTER
;;%##% FOR BENEFIT OF ERR ROUTINE
	MOVE	TEMP,(P)
	MOVEM	TEMP,UUO1(USER)
;;%##%
	MOVEM	RF,RACS+RF(USER);SAVE F-REGISTER
	SKIPE	SGLIGN(USER)
	PUSHJ	P,INSET
	MOVE	X,-1(P)		;TABLE #
	MOVEI	TEMP,-1		;ERROR IF BLOCK NOT THERE, NEEDS TO BE INIT'ED
	PUSHJ	P,BKTCHK	;CHECHK OUT TABLE #
	 JRST	[PUSH	SP,[0]	;ERROR
		PUSH	SP,[0]
		SUB	P,X33
		JRST	@3(P)]
	PUSH	P,CDB		;SAVE POINTER TO CORGET BLOCK
	PUSH	P,CHNL		;SAVE RANGE 1 TO 18
	MOVE	CHNL,-4(P)	;CHANNEL #
	LOADI7	A,<IN>		;ROUTINE NAME
	PUSHJ	P,GETCHN	;SET UP, VALIDATE
	LDB	E,[POINT 4,DMODE(CDB),35] ;DATA MODE
	CAIGE	E,15		;DUMP MODE?
	SETZM	@ENDFL(CDB)	;NO, HELP USER ASSUME NO EOF,ERR
	SETZM	@BRCHAR(CDB)	;ASSUME NO BREAK CHAR
CMU <
	SETZM	.SKIP.
>;CMU
	HRRZ	A,@ICOUNT(CDB)	;MAX COUNT FOR INPUT STRING
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)	;ENOUGH ROOM?
	PUSHJ	P,STRNGC	;NO, TRY TO GET SOME
	POP	P,TEMP
	MOVE	FF,BRKMSK(TEMP)	;GET MASK FOR THIS TABLE
	POP	P,LPSA		;LPSA POINTS AT CORGET BLOCK
	ADD	TEMP,LPSA	;TEMP IS RELOCATED 1 TO 18
	MOVEM	TEMP,-1(P)	;SAVE THIS BLOODY THING ON THE STACK
	MOVEI	Z,1		;FOR TESTING LINE NUMBERS
	SKIPN	LINTBL(TEMP)	;DON'T LET TEST SUCCEED IF
	 MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
	MOVN	B,A		;NEGATE MAX CHAR COUNT
	PUSH	SP,[0]		;LEAVE ROOM FOR FIRST STR WORD
	PUSH	SP,TOPBYTE(USER)	;SECOND STRING WORD
	MOVE	Y,LPSA
	ADD	Y,[XWD D,BRKTBL] ;BRKTBL+RLC(LPSA)
	JUMPE	B,DONE1		; BECAUSE THE AOJL WON'T
CMU <
	MOVS	C,DMODE(CDB)	;FUNNY MODE BITS TO RH
>;CMU
	TRNE	FF,@BRKCVT(LPSA) ;DOING UC COERCION?
	TLOA	C,400000	;YES
	TLZ	C,400000	;NO
	
.IN:	SOSG	ICOWNT(CDB)	;BUFFER EMPTY?
	JRST	DOINP		;YES, GET MORE
IN1:	
	ILDB	D,IBP(CDB)	;GET NEXT CHARACTER
	TDNE	Z,@IBP(CDB)	;LINE NUMBER (ALWAYS SKIPS IF NOT WORRIED)?
	JRST	INLINN		;YES, GO SEE WHAT TO DO
IN2:
NOCMU <
	JUMPE	D,.IN		;ALWAYS IGNORE 0'S
>;NOCMU
CMU <
	JUMPE	D,[ TRNN  C,1	;REALLY IGNORE NULL??
		    JRST  .IN	;YES
		    JRST  .+1	;NOPE
		   ]
>;CMU
;;%AX% ugh! another instruction
	SKIPE	LINNUM(CDB)	;COUNTING VIA SETPL?
	JRST	[ CAIN	D,12		;LF?
		  AOS	@LINNUM(CDB)	;YES -- BUMP COUNT
;; #TB# ! (CMU =C9) TYPO, USED TO BE CAIE C,14
		  CAIE	D,14		;FF?
		  JRST	.+1		;NOPE
		  SKIPN	PAGNUM(CDB)	;BE SURE NO MESSUP
		  ERR	<DRYROT -- SETPL LOSSAGE DETECTED IN INPUT>,1,NOCV.I
		  AOS	@PAGNUM(CDB)	;BUMP PAGE COUNT
		  SETZM	@LINNUM(CDB)	;THE LINE COUNT ← 0
		  JRST	NOCV.I		;SINCE KNOW NOT LOWER CASE
		]
;;%##%	COERCING ??
	JUMPGE	C,NOCV.I	;NOT COERCIING ??
	CAIL	D,"a"		;ONLY COERCE LOWER CASE
	CAILE	D,"z"		;
	JRST	.+2		;FAST SKIP
	TRZ	D,40		;MAKE UC
NOCV.I:	TDNE	FF,@Y		;MUST WE DO SOMETHING SPECIAL?
	JRST	INSPC		;YES, HANDLE

MOVEC:	IDPB	D,TOPBYTE(USER)	;LENGTHEN STRING
	AOJL	B,.IN		;GET SOME MORE
	JRST	DONE1

INSPC:	HLLZ	TEMP,@Y		;IGNORE OR BREAK?
	TDNN	TEMP,FF		;  (CHOOSE ONE)
	JRST	.IN		;IGNORE

;  BREAK -- STORE BREAK CHAR, FINISH OFF

DONE:	MOVEM	D,@BRCHAR(CDB)	;STORE BREAK CHAR
	MOVE	TEMP,-1(P)	;RELOCATED 1 TO 18
	SKIPN	Y,DSPTBL(TEMP)	;WHAT TO DO WITH BREAK CHAR?
	JRST	DONE1		;SKIP IT
	JUMPL	Y,APPEND	;ADD TO END OF INPUT STRING

RETAIN:	SOS	IBP(CDB)		;BACK UP TO GET IT NEXT TIME
	FOR II←1,4 <
	IBP	IBP(CDB)>
	AOS	ICOWNT(CDB)
	JRST	DONE1

APPEND:	IDPB	D,TOPBYTE(USER)	;PUT ON END
	AOJA	B,DONE1		;ONE MORE TO COUNT

INEOF1: POP	P,D+1		;LEFT OVER FROM DUMP MODE ROUT

;  DONE -- MARK STRING COUNT WORD

DONE1:	ADDM	B,REMCHR(USER)	;GIVE UP THOSE NOT USED
	ADD	B,@ICOUNT(CDB)	;HOW MANY DID WE ACTUALLY GET?
;;#GI# DCS 2-5-72 REMOVE TOPSTR
	HRROM	B,-1(SP)	;MARK RESULT, NON-CONSTANT
;;#GI#
	MOVE	RF,RACS+RF(USER);GET F-REGISTER BACK
	SUB	P,X33		;REMOVE INPUT PARAMETER, RETURN ADDRESS
	JRST	@3(P)		;RETURN

;  CAN EITHER DELETE LINE NUMBER (Y GT 0) OR STOP,
;  TELL THE USER (BRCHAR=-1), AND MARK LINE NUMBER
;  NOT A LINE NUMBER FOR NEXT TIME
; GET A NEW BUFFER

DOINP:
CMU <
	AOS	.SKIP.
>;CMU
	CAIL	E,15		;DUMP MODE?
	 JRST	 DMPI		; YES
	XCT	IOIN,SIMIO	;IN CHAN,0
	 JRST	 IN1		;ALL OK, CONTINUE
	 JRST	 DONE1		;ERROR OR EOF, QUIT

; DUMP MODE SIMULATION OF SAME
DMPI:	PUSH	P,D+1
	HRRZ	D,IBUF(CDB)	;PTR TO BUFFER AREA
	SUBI	D,1
	HRLI	D,-=128
	MOVEI	D+1,0
	XCT	IODIN,SIMIO	;IN CHAN,D
	 JRST	OKI
	 JRST	INEOF1		;REMOVE D,QUIT
OKI:	POP	P,D+1
	AOS	@ENDFL(CDB)	;SPECIAL TREATMENT
	HRLI	D,700
	MOVEM	D,IBP(CDB)
	MOVEI	A,5*=128
	MOVEM	A,ICOWNT(CDB)
	JRST	IN1		;DONE SIMULATING, RETURN

INLINN:
;;%AX% MORE SETPL STUFF
	SKIPE	SOSNUM(CDB)	;DOES THE USER WANT IT???
	JRST	[ MOVE	TEMP,@IBP(CDB) ;YES
		  MOVEM	TEMP,@SOSNUM(CDB);
		  JRST	.+1 ]
	MOVE	TEMP,-1(P)	;RELOCATED 1 TO 18
	SKIPGE	TEMP,LINTBL(TEMP) ;WHAT ABOUT LINE #?
	 JRST	 GIVLIN	; WANTS IT NEXT TIME OR SOMETHING
	JSP	TEMP,EATLIN	;TOSS IT OUT, AND 
	JRST	.IN		; CONTINUE

EATLIN:
	AOS	IBP(CDB)	;FORGET IT ENTIRELY
	MOVNI	A,5		;INDICATE SKIPPING SIX
	ADDB	A,ICOWNT(CDB)	;IN COUNT
				;OVERFLOW BUFFER?
	JUMPG	A,(TEMP)	;NO, CONTINUE
	CAIL	E,15
	 ERR	 <CAN'T HANDLE THIS FILE IN DUMP MODE>
	XCT	IOIN,SIMIO	;YES, GET TAB FROM NEXT BUFFER
	 JRST	OKLN		;GOT IT, CONTINUE
	 JRST	DONE1

OKLN:	SOSG	ICOWNT(CDB)	;IF ONLY ONE CHAR,
	JRST	[MOVEI TEMP,20000	;THEN EOF COMES NEXT
		 IORM  TEMP,@ENDFL(CDB)
		 JRST  DONE1]	;ALL DONE
	IBP	IBP(CDB)	;GET OVER TAB FINALLY
;;#PM  12-1-73 RLS  DONT LOSE A CHARACTER IN THE (NEW) BUFFER 
	AOS	ICOWNT(CDB)	;INCREMENT COUNT
;;#PM
	JRST	(TEMP)		;AND CONTINUE


GIVLIN:	TRNE	TEMP,-1		;WANT LINE NO IN BRCHAR WORD?
	 JRST	 GVLLN		;NO, WANTS IT NEXT TIME.
	SKIPL	TEMP,@IBP(CDB)	;NEGATED LINE NO
	MOVNS	TEMP
	MOVEM	TEMP,@BRCHAR(CDB) ;STORE WHERE HE WANTS IT
	JSP	TEMP,EATLIN	;GO EAT UP LINE NUMBER AND
	JRST	DONE1		;FINISH UP
GVLLN:
	SETOM	@BRCHAR(CDB)	;TELL THE USER
	AOS	ICOWNT(CDB)	;REVERSE THE SOSLE
	MOVEI	Y,1		;TURN OFF LINE NUMBER 
	ANDCAM	Y,@IBP(CDB)	;  BIT
	MOVSI	Y,070000	;BACK UP BYTE POINTER
	ADDM	Y,IBP(CDB)
	JRST	DONE1		;FINISH OFF IN BAZE OF GORY

ENDCOM(INP)
COMPIL(NUM,<REALIN,REALSCAN,INTIN,INTSCAN>
	  ,<SIMIO,SAVE,RESTR,X22,X33,GETCHN,NOTOPN,.CH.,.MT.,.TEN.>
	  ,<LOU PAUL'S NUMBER INPUT AND CONVERSION ROUTINES>)
COMMENT ⊗Realin, Realscan ⊗

DSCR REAL←REALIN(CHANNEL NUMBER);
CAL SAIL
⊗

HERE (REALIN)
IFN ALWAYS,<BEGIN NUMIN>

	PUSHJ P,SAVE
	PUSHJ P,NUMIN;		GET NUMBER IN A AND TEN EXPONENT IN C
	MOVE LPSA,X22
	JRST REALFN

DSCR REAL←REALSCAN(@"STRING");
CAL SAIL
⊗

HERE (REALSCAN)
	PUSHJ P,SAVE
	PUSHJ P,STRIN
	MOVE LPSA,X33
REALFN:	SETZ D,;		POS SIGN
	JUMPE A,ADON
	JUMPG A,FPOS
	SETO D,;		NUMBER NEGATIVE
	MOVNS A
FPOS:	;WE NOW HAVE A POSITIVE NUMBER IN A WITH SIGN IN D
	JFFO A,.+1;		NUMBER OF LEADING ZEROS IN B
	ASH A,-1(B);		BIT0=0, BIT1=1
	MOVN X,B;		BIN EXPONENT -2
	JUMPE C,FLO;		IF TEN EXPONENT ZERO THEN FINISH
	JUMPL C,FNEG
	CAIL C,100;		CHECK BOUND OF EXPOENT
	JRST ERROV1
	SETZ Y,
	JRST TEST
FNEG:	MOVNS C
	CAIL C,100
	JRST ERROV1
	MOVEI Y,6
TEST:	TRNE C,1;		DEPENDING ON LOW ORDER BIT OF EXP
	JRST MULT;		EITHER MULTIPLY 
NEXT:	ASH C,-1;		OR DON'T.
	AOJA Y,TEST;		INDEX INTO MULTIPLIER TABLE
MULT:	ADD X,.CH.(Y);		EXPONENT
	MUL A,.MT.(Y)		;MULTIPLY AND NORMALIZE
	TLNE A,200000
	 JRST DTEST
	ASHC A,1
	SOJA X,.+1
DTEST:	SOJG C,NEXT
FLO:	IDIVI A,1B18
	FSC A,255
	FSC B,234
	FADR A,B
	SKIPE D
	MOVNS A
	FSC A,(X);		SCALE
	JRST ALLDON
	SUBTTL	INTIN	INTEGER NUMBER INPUT ROUTINE	LOU PAUL
COMMENT ⊗Intin, Intscan ⊗

DSCR INTEGER←INTIN(CHANNEL NUMBER);
CAL SAIL
⊗

HERE (INTIN)
	;INTEGER NUMBER INPUT ROUTINE RETURNS VALUE IN A
	;USES NUMIN TO PERFORM FREE FIELD SCAN

	PUSHJ P,SAVE
	PUSHJ P,NUMIN;		GET NUMBER IN A, TEN EXPONENT IN C
	MOVE LPSA,X22
	JRST INTFN

DSCR INTEGER←INTSCAN("STRING");
CAL SAIL
⊗

HERE (INTSCAN)
	PUSHJ P,SAVE
	PUSHJ P,STRIN
	MOVE LPSA,X33
INTFN:	JUMPE A,ADON
	JUMPE C,ADON
	JUMPL C,DIVOUT;		IF EXPONENT NEG WE WILL DIVIDE
	CAIL C,13
	JRST ERROV1
	IMUL A,.TEN.(C)
	JRST ALLDON
DIVOUT:	MOVNS C
	CAIL C,13
	JRST [SETZ A,
		JRST ADON ]
	MOVE C,.TEN.(C)
	IDIV A,C
	ASH C,-1
	CAML B,C;		ROUND POSITIVELY
	AOJA A,ALLDON
	MOVNS B
	CAML B,C
	SOJ A,
ALLDON:	JOV ERROV1;		CHECK FOR OVERFLOW
ADON:	MOVEM A,RACS+1(USER)
	JRST RESTR
ERROV1:	PUSHJ P,ERROV
	JRST ADON
	SUBTTL	FREE FIELD NUMBER SCANNER		LOU PAUL
DSCR NUMIN
DES THE COMMON ROUTINE USED BY REALIN, REALSCAN, INTIN, ETC.
⊗
	;NUMIN PERFORMS A FREE FIELD READ AND RETURNS THE MOST SIGNIFICIANT
	;PART OF THE NUMBER IN A AND THE APPROPIATE TENS EXPONENT IN C
	;TAKING CARE OF LEADING ZEROS AND TRUNCATION ETC.
	;SCANNING IS ACCORDING TO THE FOLLOWING BNF
	;<NUMBER>::=<DEL><SIGN><NUM><DEL>
	;<NUM>	::=<NO>|<NO><EXP>|<EXP>
	;<NO>	::=<INTEGER>|<INTEGER>.|
	;	   <INTEGER>.<INTEGER>|.<INTEGER>
	;<INTEGER>::=<DIGIT>|<INTEGER><DIGIT>
	;<EXP>	::=E<SIGN><INTEGER>|@<SIGN><INTEGER>
	;<DIGIT>::=0|1|2|3|4|5|6|7|8|9
	;<SIGN>	::=+|-|<EMPTY>
	;NULL AND CARR. RET. ARE IGNORED.
	;SCANNING IS FACILITATED BY A CHARACTER CLASS TABLE "TAB" AND
	;TWO MACROS AHEAD AND ASTERN. THE LEFT HALF OF THE 200+1 WORD TABLE
	;CONTAINS -1 IF NOT A DIGIT AND THE VALUE OF THE DIGIT IF IT IS A DIGIT
	;THE RIGHT HALF CONTAINS -1 IF A DIGIT AND THE CLASS NUMBER IF NOT.
	;CLASS 0	NULL, CARR RET, NOTHING
	;CLASS 1	.
	;CLASS 2	-
	;CLASS 3	+
	;CLASS 4	@,E
	;CLASS 5	ANY OTHER CHARACETR
	;CLASS 6 	END OF FILE
	;TAB(200) IS USED FOR FND OF FILE
	;MACRO AHEAD IS USED FOR FORWARD SCANNING, ASTERN FOR SCANNING
	;THE STACK CONSISTING OF AC Y WHICH HAS CLASS SYMBOLS SHIFTED INTO IT.
	DEFINE AHEAD(DIG,POINT,MINUS,PLUS,E,CHA,EOF)<
	HRRE X,TAB(D)
	JRST @.+2(X)
	JUMP DIG
	JRST .-4
	JUMP POINT
	JUMP MINUS
	JUMP PLUS
	JUMP E
	JUMP CHA
	JUMP EOF>

	DEFINE ASTERN(NULL,POINT,MINUS,PLUS,E,CHA)<
	SETZ X,
	LSHC X,3
	JRST @.+1(X)
	JUMP NULL
	JUMP POINT
	JUMP MINUS
	JUMP PLUS
	JUMP E
	JUMP CHA
	JUMP CHA>
;NUMIN -- CONTD.

NUMIN:	MOVE CHNL,-2(P)
	LOADI7 A,<IN>
	PUSHJ P,GETCHN;		SET UP FOR INPUT
	SETZM @ENDFL(CDB);	CLEAR EOF AND BREAK FLAGS
	SETZM @BRCHAR(CDB)
	MOVE LPSA,[JSP X,NCH]
	MOVEI Z,1;		FOR LINE NUMBER TEST
	PUSHJ P,SCAN
	MOVEM D,@BRCHAR(CDB);	FIX UP BREAK CHARACTER
	SOS	IBP(CDB)		;BACK UP TO GET IT NEXT TIME
	FOR II←1,4 <
	IBP	IBP(CDB)>
	AOS	ICOWNT(CDB)
	POPJ P,

; READ A CHARACTER FROM INPUT FILE -- FOR SCAN.
NCH:	SOSG ICOWNT(CDB);	DECREMENT CHARACTER COUNT
	JRST NCH2
NCH1:	ILDB D,IBP(CDB);	LOAD BYTE
	TDNE Z,@IBP(CDB);	CHECK FOR LINE NUMBER
	JRST NCH5
;;%AX% UGH! MORE IN THE LOOP!!
	SKIPN	LINNUM(CDB)	;WANT SETPL STUFF???
	JRST (X) 		;NO, RETURN
	CAIN	D,12		;YES, IS THIS A LF?
	AOS	@LINNUM(CDB)	;YES, BUMP LINE COUNT
	CAIE	D,14		;A FF?
	JRST	(X)		;NOPE
	SKIPN	PAGNUM(CDB)	;BUG TRAP
	JRST    [ ERR	<DRYROT -- SETPL LOSSAGE DETECTED BY NUMIN>,1
		JRST	(X) ]
	AOS	@PAGNUM(CDB)	;BUMP PAGE COUNT
	SETZM	@LINNUM(CDB)	;ZERO LINE COUNT
	JRST	(X)		;RETURN
;;%AX%

NCH2:	XCT IOIN,SIMIO;		INPUT
	JRST NCH1		;ALL OK
NCH7:	MOVEI D,200		;EOF OR DATA ERROR.
	JRST (X)

NCH5:	
;;%AX%	MORE SETPL STUFF
	SKIPE	SOSNUM(CDB)	;DOES THE LOSER WANT IT??
	JRST	[ MOVE	D,@IBP(CDB)	;YES, GET IT
		MOVEM	D,@SOSNUM(CDB)	;WHERE HE SAID TO PUT IT
		JRST	.+1]
;;%AX%
	
	AOS IBP(CDB);		WE HAVE A LINE NUMBER
	MOVNI D,5;		MOVE OVER IT
	ADDB D,ICOWNT(CDB)
	SKIPLE D;		NOTHING LEFT
	JRST NCH;		DO ANOTHER INPUT
	XCT IOIN,SIMIO

NCH6:	SOSG ICOWNT(CDB);	REMOVE TAB
	JRST NCH7		;NONE THERE OR ERROR
	IBP IBP(CDB)
	JRST NCH

;SETUP FOR STRING INPUT (REALSCAN, INTSCAN)
STRIN:	MOVE LPSA,[JSP X,NCHA]
	HRRZ Z,-3(P)
	HRRZ Z,-1(Z)
	HRRZS -3(P)		;SO CAN INDIRECT THROUGH IT.
	PUSHJ P,SCAN
	HRRZ X,-3(P)
	SOS (X)			;BACK UP BYTE POINTER
	FOR II←1,4<
	IBP (X)>
	AOJ Z,
	HRRM Z,-1(X)
	MOVEM D,@-2(P)		;STORE BREAK CHARACTER
	POPJ P,

;READ A CHARACTER ROUTINE FOR STRINGS.
NCHA:	SOJL Z,NCH7
	ILDB D,@-4(P)
	JRST (X)

;SCAN (CALLED BY NUMIN AND STRIN)

SCAN:	JOV .+1
	SETO TEMP,		;FLAG REGISTER.
	SETZ	Y,
	SETZB A,C;		NUMBER		EXPOENT
MORE:	XCT LPSA;		THIS GETS A CHARACTER IN D,200 IF FO EOF
	AHEAD(DIG1,STACK,STACK,STACK,STACK,STACK,DONE)
STACK:	LSHC X,-3;		PUSH SYMBOL ONTO STACK "AC Y"
	JRST MORE

DIG1:	SETZ TEMP,;		FLAG REG.
	ASTERN(INT1,FRA1,SIG1,SIG2,EXP1,INT1)

SIG1:	TRO TEMP,4;		NEGATIVE SIGN
SIG2:	ASTERN(INT1,ERR2,ERR5,ERR5,EXP1,INT1)

EXP1:	MOVEI A,1
	ASTERN(EXP2,ERR2,SIG3,SIG4,ERR1,EXP2)

SIG3:	MOVNS A
SIG4:	ASTERN(EXP2,ERR2,ERR5,ERR5,ERR1,EXP2)

FRA1:	TRO TEMP,1;		DECIMAL POINT
	SOJ C,
	ASTERN(INT1,ERR2,SIG5,SIG6,ERR1,INT1)

SIG5:	TRO TEMP,4;		NEGATIVE SIGN
SIG6:	ASTERN(INT1,ERR2,ERR5,ERR5,ERR1,INT1)

EXP2:	HLRE FF,TAB(D);		FIRST DIGIT
EXP5:	XCT LPSA;		GET NEXT CHARACTER
EXP9:	HLRE B,TAB(D)
	JUMPL B,EEXP;		NEGATIVE IF NOT A DIGIT
	IMULI FF,12		
;;%##% ! (RHT) 10-25-75 IF OVERFLOW, MUST BE WRONG
;;	JOV ERR3	;JUST NOT SURE IF SHOULD DO THIS, THOUGH
	ADD FF,B
	JRST EXP5

	XCT LPSA
;;#QD# SEE DONE5: BELOW
EEXP:	AHEAD(EXP9,ERR2,DONE5,DONE5,ERR1,EN,EN)
EN:	TRNE TEMP,4;		SIGN OF EXPONENT
	MOVNS FF
	ADD C,FF;		FIX UP EXPONENT
	JOV ERR3

;#QD# CHANGE ALL 'ERR5'S IN AHEAD MACROS DO 'DONE5'S, TO AVOID SNARFING EXTRA
;SIGNS ..... RFS 12-15-73 (TWO PLACES BELOW AND ONE ABOVE ALSO)
DONE5:
DONE:	ANDI D,177
	JUMPGE TEMP,.+2
	SETO D,
	POPJ P,

INT1:	HLRE A,TAB(D);		FIRST DIGIT
	TRNE TEMP,4
	MOVNS A;		NEGATE IF NECESSARY
INT2:	XCT LPSA;		GET NEXT CHARACTER
INT5:	HLRE B,TAB(D)
	JUMPL B,EON;		NEGATIVE IF NOT A NUMBER
	TRNE TEMP,1;		IF PASSED DECIMAL POINT THEN DEC EXP BY ONE
	SOJ C,
	TRNE TEMP,2;		IF ENOUGH DIGITS THEN INC EXP BY ONE
INT3:	AOJA C,INT2
	MOVE X,A
	IMULI A,12
;;%##% RHT ! HAVE TO TRAP THESE OVERFLOWS RIGHT AWAY
	JOV INT4
	TRNE TEMP,4;		NEGATE DIGIT IS SIGN NEGATIVE
	MOVNS B
	ADD A,B
	JOV INT4;		CHECK FOR OVERFLOW
	JRST INT2;		IF SO USE LAST VALUE

INT4:	TRO TEMP,2
	MOVE A,X
;;%##% USED TO BE JRST INT3
	AOJA C,INT2

	XCT LPSA		;GET HERE FROM THE AHEAD MACRO
EON:	AHEAD(INT5,DP1,DONE,DONE,EXP6,DONE,DONE)

DP1:	TROE TEMP,1
	JRST ERR2
	XCT LPSA
;#QD# (SEE DONE5: ABOVE)
	AHEAD(INT5,ERR2,DONE5,DONE5,EXP6,DONE,DONE)

EXP6:	SETZ TEMP,
	XCT LPSA
	AHEAD(EXP2,ERR2,EXP7,EXP8,ERR1,ERR1,ERR1)

EXP7:	TRO TEMP,4
EXP8:	XCT LPSA
;#QD# (SEE DONE5: ABOVE)
	AHEAD(EXP2,ERR2,DONE5,DONE5,ERR1,ERR1,ERR1)

ERR1:	ERR(<NUMIN: IMPROPER EXPONENT>,1,RZ)

ERR2:	ERR(<NUMIN: MISPLACED DECIMAL POINT>,1,RZ)

ERR3:	ERR(<NUMIN: EXPONENT OUT OF BOUND>,1,RZ)

ERR5:	ERR(<NUMIN: MISPLACED SIGN>,1,RZ)

ERROV:	ERR(<NUMIN: NUMBER OUT OF BOUND>,1,RZ)

RZ:	SETZ A,
	JRST DONE
;   Character table for SCAN (Realscan,Intscan,Realin,Intin)
TAB:	FOR A IN (0,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,0,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
;#QC# MAKE 32 (CONTROL Z) IGNORED
	FOR A IN (5,5,0,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,3,5,2,1,5)<XWD -1,A
>
	FOR A IN (0,1,2,3,4,5,6,7,10,11)<XWD A,-1
>
	FOR A IN (5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (4,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	FOR A IN (5,5,5,5,5,5,5,5)<XWD -1,A
>
	XWD -1,6

ENDCOM(NUM)
COMPIL(TBB,<.CH.,.TEN.,.MT.>,,<TABLES FOR L PAUL'S ROUTINES>)
DSCR DATA TABLES FOR REALIN, INTSCAN, ETC.
⊗

↑↑.CH.:	4
	7
	16
	33
	66
	153
	777777777775
	777777777772
	777777777763
	777777777746
	777777777713
	777777777626
↑↑.MT.:	240000000000
	310000000000
	234200000000
	276570200000
	216067446770
	235613266501
	314631463147
	243656050754
	321556135310
	253630734215
	346453122767
	317542172553
↑↑.TEN.:	1
	=10
	=100
	=1000
	=10000
	=100000
	=1000000
	=10000000
	=100000000
	=1000000000
	=10000000000

ENDCOM(TBB)
IFN ALWAYS,<
	BEND
>;IFN ALWAYS
COMPIL(WRD,<ARRYOUT,WORDOUT,ARRYIN,WORDIN>
	  ,<GETCHN,SAVE,RESTR,GOGTAB,SIMIO,X22,X33,X44,NOTOPN>
	  ,<ARRYIN, ARRYOUT, WORDIN, AND WORDOUT>)
COMMENT ⊗Arryout, Wordout ⊗

DSCR ARRYOUT(CHANNEL,@STARTING LOC,EXTENT);
CAL SAIL
⊗

HERE (ARRYOUT)
	PUSHJ	P,SAVE
	MOVE	LPSA,[XWD 4,4]
ARO:	MOVE	CHNL,-3(P)
	LOADI7	A,<ARRYOUT>
	PUSHJ	P,GETCHN
;;%##% CONSIDER THIS
CMU <
	SETZM	@ENDFL(CDB)	;CLEAR ERROR FLAG
>;CMU
	LDB	TEMP,[POINT 4,DMODE(CDB),35] ;CHECK MODE
CMU <
;;=B4= 1 OF 13 -- FOR CMU SPECIAL MODES.
	MOVEI	Z,1		;ASSUME NOT IMP MODE
	CAIN	TEMP,3		;IS THE MODE 3?
	 TRZA	Z,-1		; YES - CMU 32-BIT IMP MODE.
				; WE WILL USE Z BOTH AS SIGNAL AND AS
				; A GUARANTEED 0 THAT CAN BE USED FOR A DPB
	CAIN	TEMP,4		; (THIS ONE IS CMU-IMAGE MODE)
	 JRST	OUTRAY		; THEN OKAY, NOT DUMP MODE EITHER.
;;=B4=
>;CMU
	CAIGE	TEMP,10		;MAKE SURE AT LEAST BINARY MODE
	 ERR	 <ARRYOUT: mode must be '14,'10, or '17, not >,6
	MOVE	0,[XCT IODOUT,SIMIO] ;IN CASE DUMP MODE
	CAIL	TEMP,15
	 JRST	 ARYDMP		;COMMON DUMP MODE ROUTINE

OUTRAY:	MOVE	A,-2(P)		;STARTING LOC
	SKIPGE	B,-1(P)		;EXTENT
	ERR	<ARRYOUT: negative word count, value is>,6

;;#FQ# DCS 2-6-72 (1-4) COUNT NO LONGER HELD EXCESSIVE

WOUT2:	SKIPG	E,OCOWNT(CDB)	;# WORDS LEFT IN BUFFER
	JRST	WOUT5		;BETTER GET ANOTHER BUFFER
	JUMPE	B,RESTR		;NOTHING LEFT TO DO
CMU <
;;=B4= 2 OF 13
	CAIN	Z,0		;IMP MODE?
	LSH	E,-2		;DIVIDE BY 4 TO GET WORD COUNT
;;=B4=
>;CMU
	IBP	OBP(CDB)	;MAKE SURE PTRS TO FIRST WORD
CMU <
;;=B4= 3 OF 13
	CAIN	Z,0		;IMP MODE?
	DPB	Z,[POINT 6,OBP(CDB),5]
;;=B4=
>;CMU
	MOVE	C,OBP(CDB)	;"TO" ADDR
	HRRZI	D,(C)		;FOR BLT TERMINATION CALCULATION
	HRLI	C,(A)		;"FROM" ADDR
	CAIGE	B,(E)		;ENUFF IN BUFFER?? (NOTICE THAT CAIGE
				;AS OPPOSED TO CAIG WILL FORCE AN OUTPUT
				;IF WE JUST FILL THE BUFFER)
	JRST	WOUT3		;YES
	ADDI	D,-1(E)		;FINAL ADDR
	BLT	C,(D)		;DO IT!
	ADDI	A,(E)		;UPDATE PTR
	SUBI	B,(E)		;AND COUNT
	SETZM	OCOWNT(CDB)
	HRRM	D,OBP(CDB)
WOUT5:	XCT	IOOUT,SIMIO	;DO THE OUTPUT
	JFCL			;ERRORS HANDLED ALREADY
	JRST	WOUT2		;TRY NEXT CHUNK

WOUT3:	JUMPLE	B,RESTR		;NOTHING TO MOVE
	SUBI	B,1
	ADD	D,B		;END OF BLOCK
	BLT	C,(D)		;MOVE IT
	SUBI	E,1(B)		;FIX LENGTH
CMU <
;;=B4= 4 OF 13
	CAIN	Z,0		;IMP MODE?
	 LSH	E,2		;MULTIPLY BY 4 FOR BYTE COUNT
;;=B4=
>;CMU
	MOVEM	E,OCOWNT(CDB)	;
	ADDM	B,OBP(CDB)	;FIX BYTE POINTER
;;#FQ# (1-4)
	JRST	RESTR		;LEAVE LIKE A TREE AND MAKE

DSCR WORDOUT(CHAN,VALUE);
CAL SAIL
⊗

HERE (WORDOUT)			;WRITE ONE WORD
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	MOVE	CHNL,-2(P)
	LOADI7	A,<WORDOUT>
	PUSHJ	P,GETCHN
;;%##% CONSIDER THIS
CMU <
	SETZM	@ENDFL(CDB)	;CLEAR ERROR FLAG
>;CMU
	LDB	A,[POINT 4,DMODE(CDB),35];DATA MODE
	CAIL	A,15		;A DUMP MODE?
	 JRST	 DMPWO		;WO IS ME, YES
;;#FQ# DCS 2-6-72 (2-4) WORD COUNT KEPT CORRECT, DUMP MODE OK
WDO:	SOSL	OCOWNT(CDB)	;BUFFER FULL?
	 JRST	 WOKO		;NO
	XCT	IOOUT,SIMIO	;YES, WRITE IT
	 JFCL			; ERRORS HANDLED ELSEWHERE
	JRST	WDO		;GO BACK AND DO IT RIGHT
WOKO:	MOVE	TEMP,-1(P)	;THING TO BE WRITTEN
	IDPB	TEMP,OBP(CDB)	;WRITE IT
	JRST	RESTR

DMPWO:	MOVE	LPSA,[XWD 7,7]	;ACCOUNT FOR EVERYTHING
	MOVEI	TEMP,-1(P)	;PNT TO WORD TO BE WRITTEN
	PUSH	P,-2(P)		;CHANNEL
	PUSH	P,TEMP		;ADDR OF WORD
	PUSH	P,[1]		;COUNT
	PUSHJ	P,ARO		;JOIN THE ROUTINE (RETAD JUST FOR STACK SYNCH)
;;#FQ# (2-4)
COMMENT ⊗Arryin, Wordin ⊗

DSCR ARRYIN(CHAN,@STARTING LOC,EXTENT);
CAL SAIL
⊗

HERE (ARRYIN)
	PUSHJ	P,SAVE
	MOVE	LPSA,X44
ARI:	MOVE	CHNL,-3(P)
	LOADI7	A,<ARRYIN>
	PUSHJ	P,GETCHN
	SETZM	@ENDFL(CDB)	;ASSUME NO END OF FILE
	LDB	TEMP,[POINT 4,DMODE(CDB),35] ;CHECK DUMP MODE
CMU <
;;=B4= 5 OF 13
	MOVEI	Z,1		;ASSUME NOT IMP MODE
	CAIN	TEMP,3		;IS THE MODE 3?
	 TRZA	Z,-1		; YES - CMU 32-BIT IMP MODE.
	CAIN	TEMP,4		;IF ONE OF THE SPECIAL CMU MODES,
	 JRST	INARY		; THEN OKAY, NOT DUMP MODE EITHER
;;=B4=
>;CMU
	CAIGE	TEMP,10
	 ERR	 <ARRYIN: mode must be '10 or '14 or '17, not >,6
	MOVE	0,[XCT IODIN,SIMIO] ;IN CASE DUMP MODE
	CAIL	TEMP,15
	 JRST	 ARYDMP		;USE COMMON ROUTINE

;;#FQ# DCS 2-6-72 (3-4) COUNT NO LONGER HELD EXCESSIVE
INARY:	MOVE	A,-2(P)		;STARTING LOC
	SKIPGE	B,-1(P)		;EXTENT
	ERR	<ARRYIN: negative word count, value is >,6
WIN3:	JUMPE	B,RESTR		;NOTHING LEFT TO DO
	SKIPG	E,ICOWNT(CDB)	;#LEFT IN BUFFER
	JRST	WIN5
CMU <
;;=B4= 6 OF 13
	CAIN	Z,0		;IMP MODE?
	 LSH	E,-2		;DIVIDE BY 4 TO GET WORD COUNT
;;=B4=
>;CMU
	IBP	IBP(CDB)	;MAKE SURE PTS TO NEXT
	HRL	C,IBP(CDB)	;ADDR OF FIRST WORD TO READ
	MOVEI	D,(A)		;FOR BLT TERMINATION
	HRR	C,A		;"TO" ADDRESS
	CAIG	B,(E)		;ENOUGH HERE?
	JRST	WIN4		;YES
	ADDI	D,-1(E)		;NO, FINISH THIS BUFFER
	BLT	C,(D)
	ADD	A,E		;FIX INPUT POINTER
	SUB	B,E		;FIX INPUT COUNT
WIN5:	XCT	IOIN,SIMIO	;DO INPUT
	JRST	WIN3		;OK, GO AHEAD
	JRST	WIEOF1		;EOF OR ERROR, LEAVE

WIN4:	ADDI	D,-1(B)		;FINISH UP
	BLT	C,(D)
	SUB	E,B		;FIX UP COUNT
CMU <
;;=B4= 7 OF 13
	CAIE	Z,0		;IMP MODE?
	 JRST	.+3
	LSH	E,2		;MULTIPLY BY 4 FOR BYTE COUNT
	DPB	Z,[POINT 6,IBP(CDB),5]
;;=B4=
>;CMU
	SUBI	B,1		;PREPARE TO CORRECT BP
	MOVEM	E,ICOWNT(CDB)	;UPDATE WORDS LEFT
	ADDM	B,IBP(CDB)	; POINTER
;;#FQ# (3-4)
	JRST	RESTR		;LEAVE

WIEOF1:	MOVE	TEMP,-1(P)	;#WORDS WANTED -1
	SUBM	TEMP,B		;#INPUT IN RH
WIN2:	HRRM	B,@ENDFL(CDB)	;#INPUT IN RH, ERR OR EOF BITS IN LH
	JRST	RESTR

DSCR VALUE←WORDIN(CHAN);
CAL SAIL
⊗

HERE (WORDIN)			;READ ONE WORD -- USE ARRYIN
	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	LOADI7	A,<WORDIN>
	MOVE	CHNL,-1(P)	;CHANNEL NUMBER
	PUSHJ	P,GETCHN
;;#FQ# DCS 2-6-72 (4-4) WORD COUNT KEPT CORRECT, DUMP MODE OK
	LDB	TEMP,[POINT 4,DMODE(CDB),35];DATA MODE
	CAIL	TEMP,15		;DUMP MODE?
	 JRST	 DUMPWI		; YES
	SETZM	@ENDFL(CDB)
WI:	SOSL	ICOWNT(CDB)
	 JRST	 WOKI		;ALL OK
	XCT	IOIN,SIMIO
	 JRST	 WI		;OK, GO BACK TO KEEP COUNT RIGHT
	 TDZA	 A,A		;RETURN 0, WITH ERROR
WOKI:	ILDB	A,IBP(CDB)	;OK, RETURN NEXT WORD
	MOVEM	A,RACS+1(USER)	;RESULT
	JRST	RESTR

DUMPWI:	MOVE	LPSA,[XWD 6,6]
	MOVEI	TEMP,RACS+1(USER);RESULT GOES HERE
	PUSH	P,-1(P)		;CHANNEL
	PUSH	P,TEMP		;ADDRESS
	PUSH	P,[1]		;1 WORD TRANSFER
	PUSHJ	P,ARI		;WON'T RETURN, JUST SYNCH STACK
;;#FQ# (4-4)

ARYDMP:	
	MOVN	TEMP,-1(P)		;-WORD COUNT
	JUMPGE	TEMP,[ERR <DUMP MODE WORD COUNT NOT POSITIVE, VALUE IS >,6]
	SOS	D,-2(P)			;STARTING ADDR - 1
	HRL	D,TEMP			;IOWD -COUNT,STARTING ADDR -1
	MOVEI	D+1,0			;TERMINATE THE READ
	MOVE	A,[JRST RESTR] ;IF IT SUCCEEDS
	MOVE	B,[JRST RESTR] ;IF IT FAILS (EOF OR ERR, ALREADY HANDLED)
	JRST	0		;GO DO DUMP I/O

HERE(WRDSP1)
HERE(WRDSP2)
HERE(WRDSP3)

	ERR	<DRYROT WRD SPARES>

ENDCOM(WRD)
COMPIL(THR,<INOUT>,<SIMIO,SAVE,RESTR,GETCHN>
	,<THROUGH I/O ROUTINE>)


COMMENT ⊗ INOUT ⊗

DSCR INOUT(INCHAN,OUTCHAN,EXTENT);
CAL  SAIL
⊗

HERE (INOUT)
	PUSHJ	P,SAVE		;SAVE AC'S,GET GOGTAB
	MOVE	LPSA,[XWD 6,6]
	MOVE	CHNL,-2(P)	;OUTPUT CH NUMBER
	LOADI7	A,<INOUT (OUTPUT SIDE)>
	PUSHJ	P,GETCHN
	SETZM	@ENDFL(CDB)	;CLEAR ERROR INDICATOR
	LDB	TEMP,[POINT 4,DMODE(CDB),35] ;CHECK MODE
CMU <
;;=B4= 8 OF 13
	MOVEI	Z,1
	CAIN	TEMP,3		;IS THE MODE 3
	 TRZA	Z,-1		; YES!!!
	CAIN	TEMP,4		;OR CMU IMAGE MODE?
	 JRST	.+4		;UGLY, BE CAREFUL OF CODE CHANGES!
;;=B4=
>;CMU
	CAIL	TEMP,10		;MUST BE BINARY MODE
	CAILE	TEMP,14		;AND NOT DUMP MODE
	ERR	<INOUT (OUTPUT SIDE): ILLEGAL DATA MODE:>,6
	PUSH	P,CDB		;SAVE - 
	PUSH	P,CHNL		;WELL DO IT AGAIN
	MOVE	CHNL,-5(P)		;SEE...
	LOADI7	A,<INOUT (INPUT SIDE)>
	PUSHJ	P,GETCHN	;DO YOUR THING
	SETZM	@ENDFL(CDB)	;CLEAR ERROR INDICATOR
	LDB	TEMP,[POINT 4,DMODE(CDB),35]
CMU <
;;=B4= 9 OF 13
	MOVEI	Y,1
	CAIN	TEMP,3		;IS THE MODE 3
	 TRZA	Y,-1		;YES!!!
	CAIN	TEMP,4		;OR CMU IMAGE MODE
	 JRST	.+4		;CAREFUL OF RELATIVE JUMPS!
;;=B4=
>;CMU
	CAIL	TEMP,10
	CAILE	TEMP,14
	ERR	<INOUT (INPUT SIDE): ILLEGAL DATA MODE:>,6
	SKIPGE	B,-3(P)		;# OF WORDS
	HRLOI	B,377777	;ARBITRARILY LARGE NUMBER OF WDS
TH1:	JUMPE	B,RESTR		;NO MORE TO DO
	SKIPG	E,ICOWNT(CDB)	;#OF WORDS IN BUFFER
	JRST	TH5		;BETTER GET SOME MORE
CMU <
;;=B4= 10 OF 13
	CAIN	Y,0		;IMP MODE?
	 LSH	E,-2		;DIVIDE BY 4 TO GET WORD COUNT
;;=B4=
>;CMU
	IBP	IBP(CDB)	;MAKE SURE POINT TRIGHT
	HRL	C,IBP(CDB)	;INPUT POINTER
	EXCH	CHNL,(P)	;NOW FREEN OUTPUT STUFF
	EXCH	CDB,-1(P)
	SKIPG	OCOWNT(CDB)	;SOME LEFT
	XCT	IOOUT,SIMIO
	SKIPA
	JRST	THERR
	IBP	OBP(CDB)
	HRR	C,OBP(CDB)	;OUTPUT POINTER
	CAML	E,B		;FIND # OF WORDS
	MOVE	E,B		;TO BLIT
NOCMU <
;;=B4= 11 OF 13
	CAML	E,OCOWNT(CDB)	;=MIN(B,ICOWNT,OCOWNT)
	MOVE	E,OCOWNT(CDB)
>;NOCMU
CMU <
	CAMGE	E,OCOWNT(CDB)	;=MIN(B,ICOWNT,OCOWNT)
	JRST	.+4
	MOVE	E,OCOWNT(CDB)
	CAIN	Z,0		;IMP MODE?
	LSH	E,-2		;DIVIDE BYTE COUNT BY 4
;;=B4=
>;CMU
	MOVEI	D,(C)		;MAKE BLT TERMINATOR
	ADDI	D,-1(E)		;FINAL ADDRESS
	BLT	C,(D)		;CHOMP CHOMP
	SUB	B,E		;WE'VE DONE THESE
	MOVEI	A,-1(E)		;TO UPDATE BYTE POINTER
	ADDM	A,OBP(CDB)	;TOLD YOU SO
CMU <
;;=B4= 12 OF 13
	CAIE	Z,0		;IMP MODE?
	 JRST	.+3
	LSH	E,2		;MULTIPLY BY 4 FOR BYTE COUNT
	DPB	Z,[POINT 6,OBP(CDB),5]
;;=B4=
>;CMU
	SUBM	E,OCOWNT(CDB)	;UPDATE WORD COUNT
	MOVNS	OCOWNT(CDB)	;CLEVER,EH?
TH6:	EXCH	CHNL,(P)	;BACK TO INPUT SETUP
	EXCH	CDB,-1(P)
	ADDM	A,IBP(CDB)	;UPDATE INPUT PTR
CMU <
;;=B4= 13 OF 13
	CAIE	Y,0		;IMP MODE?
	 JRST	.+3
	LSH	E,2		;MULTIPLY BY 4 FOR BYTE COUNT
	DPB	Y,[POINT 6,IBP(CDB),5]
;;=B4=
>;CMU
	SUBM	E,ICOWNT(CDB)	;UPDATE WORD COUNT
	MOVNS	ICOWNT(CDB)	;SUBTRACTION WAS BACKWARDS
	JRST	TH1		;MORE OF SAME
TH5:	XCT	IOIN,SIMIO	;DO SOME INPUT
	JRST	TH1		;NOW GO PLAY
THERR:	SKIPGE	TEMP,-3(P)	;# THE GUY WANTED
	HRLOI	TEMP,377777	;IT WAS A FUDGE
	SUB	TEMP,B		;SUBTRACT #LEFT TO GET
	HRRM	TEMP,@ENDFL(CDB);#HE GOT
	JRST	RESTR

ENDCOM(THR)
COMPIL(LIN,<LINOUT>,<SIMIO,SAVE,RESTR,GETCHN,X33>,<LINOUT ROUTINE>)
COMMENT ⊗Linout ⊗

DSCR LINOUT(CHANNEL,VALUE);
CAL SAIL
⊗

HERE (LINOUT)
	PUSHJ	P,SAVE
	MOVE	CHNL,-2(P)	;CHANNEL
	LOADI7	A,<LINOUT>
	PUSHJ	P,GETCHN	;CHANNEL DATA
	MOVE	TEMP,OBP(CDB)	;ADJUST TO FULL WORD
	HRRZ	A,OCOWNT(CDB)	;DON'T FORGET COUNT
LINOLP:	TLNN	TEMP,760000	;LINED UP?
	 JRST	 OKLIGN		; YES
	IBP	TEMP		;0 WILL BE THERE
	SOJA	A,LINOLP

OKLIGN:	MOVEM	TEMP,OBP(CDB)
	MOVEM	A,OCOWNT(CDB)	;REPLACE UPDATED THINGS
	CAIGE	A,=10		;ENOUGH ROOM FOR 2 WORDS?
	 XCT	 IOOUT,SIMIO	;NO, OUTPUT
	 JFCL			;IN CASE OUTPUT HAPPENED

	SKIPGE	B,-1(P)		;GET LINE NUMBER
	 JRST	 [MOVNS B
		  MOVNI A,5	;ONLY PUT OUT 5 CHARS
		  JRST NOCONV]	;WAS GIVEN TO US IN TOTO
	MOVNI	A,6		;PUT OUT TAB AFTER
	MOVE	C,[<ASCII /00000/>/2] ;TO MAKE 5
	EXCH	B,C
	PUSH	P,LNBAK		;RETURN ADDR
LNCONV:	IDIVI	C,=10
	IORI	D,"0"
	DPB	D,[POINT 7,(P),6]
	SKIPE	C		;THE RECURSIVE PRINTER
	PUSHJ	P,LNCONV
	HLL	C,(P)		;ONE CHAR, LEFT JUST
	LSHC	B,7
LNBAK:	POPJ	P,.+1
	LSH	B,1
	TRO	B,1
NOCONV:	AOS	C,OBP(CDB)	;MOVE OUT A WORD
	MOVEM	B,(C)
	ADDM	A,OCOWNT(CDB)	;UPDATE COUNT
	MOVEI	B,11
	CAME	A,[-5]
	 IDPB	 B,OBP(CDB)	;OUTPUT A TAB
NOTAB:	MOVE	LPSA,X33
	JRST	RESTR		;THAT'S IT

ENDCOM(LIN)

COMMENT ⊗Breakset,setbreak,stdbrk fakes⊗

;;%  % MOVED IT TO STRSER

COMPIL(CLS,<CLOSIN,CLOSO,CLOSE>,<SAVE,RESTR,SIMIO,X33>,<CLOSE ROUTINES>)
COMMENT ⊗Close, Closin, Closo
  CLOSE(CHAN)     

CLOSIN closes only the input side
CLOSO closes only the output side

⊗
DSCR CLOSIN(CHAN)
CAL SAIL
⊗

HERE (CLOSIN) PUSHJ	P,SAVE		;CLOSE INPUT ONLY
	MOVEI	D,1
	JRST	CLSS

DSCR CLOSO(CHANNEL);
CAL SAIL
⊗
HERE (CLOSO)	
	PUSHJ	P,SAVE		;CLOSE OUTPUT ONLY
	MOVEI	D,2
	JRST	CLSS
DSCR CLOSE(CHANNEL);
CAL SAIL
⊗
.CLS:
HERE (CLOSE)				;CLOSE BOTH
	PUSHJ	P,SAVE		;SAVE ACS AND THINGS
CLSS:	
;;%BQ% RHT 10-11-74 ALLOW CLOSE TO TAKE INHIBIT BITS AS AN ARGUMENT
;; FOLLOWING WAS MOVE LPSA,X22
	MOVE	LPSA,X33
;; FOLOWING WAS CHNL,-1(P)
	MOVE	CHNL,-2(P)	;CHANNEL #
	HRRZ	D,-1(P)		;CHANNEL CLOSE INHIBIT BITS
;;%BQ% ↑
	CHKCHN	CHNL,<CLOSE>	;VERIFY OK CHANNEL
	SKIPN	CDB,@CDBLOC(USER) ;GET CDB
	 JRST	 RESTR		;NOT OPEN, DON'T CLOSE
	XCT	IOCLOSE,SIMIO	;CLOSE CHAN,SPEC
	SETZM	INAME(CDB)
	SETZM	ONAME(CDB)	;NO FILE NAMES OPEN
	JRST	RESTR		;RETURN

ENDCOM(CLS)
COMPIL(MTP,<MTAPE,USETI,USETO,RENAME,ERENAME>
	  ,<SAVE,RESTR,GETCHN,SIMIO,FILNAM,X22,X33,X44>
	  ,<MTAPE, USETI, USETO, RENAME ROUTINES>)
COMMENT ⊗Mtape ⊗

DSCR MTAPE(CHANNEL,MODE);
CAL SAIL
⊗

.MTP:
HERE (MTAPE)
	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	MOVE	CHNL,-2(P)		;CHANNEL NUMBER
	LOADI7	A,<MTAPE>
	PUSHJ	P,GETCHN
	LDB	C,[POINT 5,-1(P),35]	;PART OF COMMAND CHAR
EXPO <
	MOVEI	B,101
	CAIN	C,11			;MTAPE "I" DOES SPECIAL THINGS.
	 JRST	 MTAPQ			;GO SET IBM COMPABILITY MODE
>;EXPO
;;%##%	ALLOW MTAPE(NULL) TO DO A MTAPE 0 -- WAIT
	MOVEI	B,0
	JUMPE	C,MTAPQ			;THIS IS DEFINITELY NOT A NO-OP
	MOVE	A,OPTAB			;COMMAND BITS
	MOVE	B,OPTAB+1		;MORE
	TRZE	C,30			;COMPRESS TABLE
	ADDI	C,5
	LSH	C,2			;EACH COMMAND IS 4 BITS
	ROTC	A,(C)			;GET RIGHT COMMAND
	ANDI	B,17			;DO IF SYSTEM DOESN'T
	JUMPE	B,[ERR	<MTAPE: ILLEGAL CODE>,1
		JRST	RESTR]
MTAPQ:	HRLI	B,(<MTAPE>)		;CREATE MTAPE OPERATION
	DPB	CHNL,[POINT 4,B,12]
;%##%	TRNE	B,-1			;IS THERE AN OPERATION?
	XCT	B			;YES, DO IT
	JRST	RESTR

OPTAB:	BYTE (4) 16,17,0,0,3,6,7,13,10	;A,B,,,E,F,R,S,T
	BYTE (4) 11,0,1			;U,,W
COMMENT ⊗ Useti, Useto, Rename ⊗

DSCR USETI,USETO(CHANNEL,BLOCK #);
CAL SAIL
⊗

HERE (USETI)
↑↑.USETI:
	SKIPA	LPSA,[XCT IOSETI,SIMIO]	;USETI
HERE (USETO)
↑↑.USETO:
	MOVE	LPSA,[XCT IOSETO,SIMIO] ;USETO
	PUSHJ	P,SAVE
	MOVE	CHNL,-2(P)
	LOADI7	A,<USET>
	PUSHJ	P,GETCHN
	MOVE	A,-1(P)			;VALUE TO USETO
	MOVE	LPSA+1,[JRST .+2]	;BE ABLE TO GET BACK
	JRST	LPSA			;GO TO USETI/O
	MOVE	LPSA,X33
	JRST	RESTR

DSCR RENAME(CHANNEL,"NEW NAME",PROTECTION,@FAILURE FLAG);
     ERENAME(CHANNEL,"NEW NAME",PROT,DATE(0),TIME(0),MODE(0),@FLG);
CAL SAIL
⊗

HERE (RENAME)
↑↑.RENAME:
	PUSHJ	P,SAVE
	SETZM	@-1(P)
	MOVE	LPSA,X44
	LOADI7	A,<RENAME>
	MOVE	CHNL,-3(P)
	PUSHJ	P,GETCHN
	PUSHJ	P,FILNAM	;PARSE FILENAME SPEC
	 JRST	 BDSPC		;SPECIFICATION NO GOOD
	MOVE	TEMP,-2(P)
	TDZE	TEMP,[XWD 777777,777000] ;MAKE THIS RENAME STERILE
	ERR	<ATTEMPT TO SET MODE OR DATE VIA RENAME.
USE ERENAME INSTEAD>,1
	ROT	TEMP,-=9
.RENIT:	MOVEM	TEMP,FNAME+2(USER)
	XCT	IORENAME,SIMIO	;DO THE RENAME
	 JRST	 RNERR		;NO GOOD
	JRST	RESTR
BDSPC:	HRRZ	TEMP,ERRTST(CDB)	;SEE IF
	TRNE	TEMP,10000		;WILLING TO HANDLE ERROR
	ERR	<RENAME: INVALID FILE SPECIFICATION>,1 ;NO, TELL HIM
	SKIPA	TEMP,[=8]		;ALWAYS REPORT CODE
RNERR:	HRRZ	TEMP,FNAME+1(USER)	;RETURN HORSESHIT NUMBER
	HRROM	TEMP,@-1(P)		;TO THE USER
	JRST	RESTR
;;%BY%

HEREFK(ERENAME,ERENA.)
	PUSHJ	P,SAVE
	SETZM	@-1(P)
	MOVE	LPSA,[XWD 7,7];
	LOADI7	A,<ERENAME>		;
	MOVE	CHNL,-6(P);
	PUSHJ	P,GETCHN
	PUSHJ	P,FILNAM		;PARSE ID SPEC;
	JRST	BDSPC			;LOST
	SKIPN	TEMP,-4(P)		;DATE
	JRST	EREN.1			;NO DATE
	LDB	C,[POINT 3,TEMP,=23]	;PICK UP HIGH ORDER BITS
	DPB	C,[POINT 3,FNAME+1(USER),=20] ;PUT THEM AWAY
EREN.1:	MOVE	C,-5(P)			;PROT
	DPB	C,[POINT =9,TEMP,=8]	;PUT AWAY
	MOVE	C,-2(P)			;MODE
	DPB	C,[POINT 4,TEMP,=12]	;PUT AWAY
	MOVE	C,-3(P)			;TIME
	DPB	C,[POINT =11,TEMP,=23]	;PUT AWAY
	JRST	.RENIT
;;%BY% ↑

ENDCOM(MTP)
COMMENT ⊗where Usercon used to be⊗


COMMENT ⊗Ttyuuo functions ⊗

DSCR TTYUUO FUNCTIONS
CAL SAIL
⊗

Comment ⊗
INTEGER PROCEDURE INCHRW;
 RETURN A CHAR FROM TTCALL 0,

INTEGER PROCEDURE INCHRS;
 RETURN -1 IF NO CHAR WAITING, ELSE FIRST CHAR (TTCALL 2,)

STRING PROCEDURE INCHWL;
 WAIT FOR A LINE, THEN RETURN IT (TTCALL 4, FOLLOWED BY TTCALL 0'S)

STRING PROCEDURE INCHSL(REFERENCE INTEGER FLAG);
 FLAG←-1, STR←NULL IF NO LINE, ELSE FLAG←0, 
	STR←LINE (TTCALL 5, FOLLOWED BY TTCALL 0'S)

STRING PROCEDURE INSTR(INTEGER BRCHAR);
 RETURN ALL CHARS TO AND NOT INCLUDING BRCHAR (TTCALL 0'S)

STRING PROCEDURE INSTRL(INTEGER BRCHAR);
 WAIT FOR ONE LINE, THEN DO INSTR (TTCALL 4, FOLLOWED BY INSTR)

STRING PROCEDURE INSTRS(REFERENCE INTEGER FLAG; INTEGER BRCHAR);
 FLAG←-1, STR←NULL IF NO LINES, ELSE FLAG←0, 
  STR←INSTR(BRCHAR)


PROCEDURE OUTCHR(INTEGER CHAR);
 OUTPUT CHAR (TTCALL 1)

PROCEDURE OUTSTR(STRING STR);
 OUTPUT STR (TTCALL 3)


PROCEDURE CLRBUF;
 CLEARS INPUT BUFFER (TTCALL 11,)

TTYIN, TTYINS, TTYINL (TABLE, @BRCHAR);
 TTYIN WORKS WITH TTCALL 0'S; TTYINS DOES A SKIP
 ON LINE FIRST, RETURNING NULL AND -1 IN BREAK IF NO LINES
 TTYINL DOES A WAIT FOR LINE FIRST.
 FULL BREAKSET CAPABILITIES EXCEPT FOR 
 "R" MODE (AND OF COURSE, LINE NUM. STUFF)

	TITLE	TTYUUO
⊗

;;%##% ADD TTYUP TO ALL THIS
COMPIL(TTY,<INCHRW,INCHRS,INCHWL,INCHSL,INSTR,OUTCHR,OUTSTR,TTYUP
ENTINT	<INSTRL,INSTRS,CLRBUF,TTYIN,TTYINS,TTYINL>>
  ,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,BKTCHK,.SKIP.,.SONTP>
	  ,<TELETYPE FUNCTIONS>)
;;#GF# DCS 2-1-72 (1-3) INCHWL BREAKS ON ALL ACTIVATION, TELLS WHICH IN .SKIP.
; .SKIP. EXTERNAL ABOVE
;;#GF#

EXPO <
IFE ALWAYS,<
EXTERN OTSTRBF
;;%CS% JFR 7-30-75 BACKUP EXISTS ON DEC SYSTEMS, TOO
NOTENX<
ENTRY BACKUP
>;NOTENX
>;IFE ALWAYS
>;EXPO

;;%##% FOR TTYUP THING
DEFINE KONVERT(AC) <
	SKIPN	TTYCVT(USER)
	JRST	.+5
	CAIL	AC,"a"
	CAILE	AC,"z"
	JRST	.+2
	TRZ	AC,40	;FORCE TO BE LOWER CASE
>

HERE (INCHRW)	TTCALL	A
;;%##%
	MOVE	USER,GOGTAB
	KONVERT	(A)
	POPJ	P,

HERE (INCHRS)	TTCALL	2,A		;SKIP IF CHAR WAITING
	MOVNI	A,1		;ELSE RETURN -1
;;%##%
	MOVE	USER,GOGTAB
	KONVERT(A)
	POPJ	P,

HERE (OUTCHR)	TTYUUO	1,-1(P)		;OUTPUT THE PARAMETER
	SUB	P,X22		;REMOVE PARAMETER
	JRST	@2(P)

HERE (OUTSTR)
;;#FO# 11-18-71 DCS (1-2)
EXPO <
;;#FO#
;;#HC# 5-11-72 DCS MAKE OUTSTR BETTER IN EXPO VERSION (DUE TO LDE)
;;#MM# 5-25-73 ! MAKE SURE ITS LOADED BEFORE WE USE IT
	MOVE 	USER,GOGTAB
	EXCH	A,-1(SP)		;LENGTH OF STRING
	HRRZS	A			; REALLY
	EXCH	B,(SP)			;PTR TO THE STRING
	PUSH	P,C			;NEED ANOTHER AC
	JUMPLE	A,OU.OUT		;DON'T DO ANYTHING
OSLOOP:	MOVE	C,A
	SUBI	A,14*5-1		;# CHARS/CHOMP
	SKIPLE	A			;LOTS LEFT??
	MOVEI	C,14*5-1		; YES,
;;%##% BETTER PLACE THAN SGACS
	MOVE	LPSA,[POINT 7,OTSTRBF];AS GOOD A PLACE AS ANY
	ILDB	TEMP,B
	SKIPE	TEMP			;NULL??
	IDPB	TEMP,LPSA		; NO
	SOJG	C,.-3
	MOVEI	TEMP,0			;A NULL FOR THE END
	IDPB	TEMP,LPSA
	TTCALL	3,OTSTRBF		;RAISON D'ETRE
	JUMPG	A,OSLOOP
OU.OUT:	POP	SP,B
	POP	SP,A
	POP	P,C
	POPJ	P,
;;#HC#
;;#FO# 11-18-71 DCS (2-2) MAKE OUTSTR WORK EFFICIENTLY USING TTYMES (STANFO ONLY)
>;EXPO
NOEXPO <
	HLRZ	TEMP,(SP)		;SIZE/POSITION FIELDS OF BP
	TRZ	TEMP,7777		;CLEAR SIZE FIELD
	OR	TEMP,-1(SP)		;POSITION, COUNT IN RH FOR DDTOUT
	TRNN	TEMP,7777		;IF NULL STRING, QUIT
	 JRST	 QUIT
	HRLM	TEMP,(SP)
	MOVE	TEMP,[SIXBIT /TTY/]	;DEVICE FOR TTYMES
	MOVEM	TEMP,-1(SP)
	MOVEI	TEMP,-1(SP)		;POINT AT SPEC
	CALLI	TEMP,400047		;WRITE FIRST CHAR FOR LENGTH CHARS
;THIS IS THE SPECIAL TTYMES UUO AS PROVIDED BY HELLIWELL
	 JFCL				;IT HAS BEEN KNOW TO SKIP-RETURN
QUIT:	SUB	SP,X22			;REMOVE THE ARGUMENT
>;NOEXPO
;;#FO#
	POPJ	P,			;DONE

TTWCHR←←=100	;MAX NUMBER OF CHARS ON TTY INPUT
CMU <		;EXCEPT WE HAVE LARGER INPUT BUFFERS
TTWCHR←←=140
>;CMU
REDSTR:	SKIPE	SGLIGN(USER)
	PUSHJ	P,INSET
	MOVEI	A,TTWCHR
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)
	PUSHJ	P,STRNGC
	MOVNI	A,TTWCHR
	PUSH	SP,[0]		;NULL STRING IF NOTHING DONE
	PUSH	SP,TOPBYTE(USER)
	POPJ	P,

FINSTR:	CAIN	TEMP,15	;REMOVE LFD IF CR BROKE IT
	TTCALL	TEMP
FINS1:	ADDM	A,REMCHR(USER)	;NUMBER NOT USED
	ADDI	A,TTWCHR		;NUMBER USED
;;#GI# DCS 2-5-72 REMOVE TOPSTR
;;%##% ALLOW FOR ITERATIVE GETTING OF TTWCHR CHARS
	HRROS  -1(SP)		; TO STRING COUNT WORD
	ADDM	A,-1(SP)	;UPDATE COUNT WORD
;;#GI#
	JRST	RESTR

HERE (INSTR) PUSHJ	P,SAVE
	PUSHJ	P,REDSTR
	MOVE	B,-1(P)		;BREAK CHAR
	MOVE	LPSA,X22	;# TO REMOVE

INS1:	PUUO	0,TEMP		;NEXT CHAR
;;%##%
	KONVERT	(TEMP)		;**** CONVERT BEFORE TEST BREAKEDNESS *****
INS2:	CAMN	TEMP,B		;BREAK?
	 JRST	 FINSTR		; YES, ALL DONE
	IDPB	TEMP,TOPBYTE(USER) ;PUT IT AWAY AND
;;%  %  LDE  BETTER NOT READ IN TOO MANY CHARACTERS
	AOJL	A,INS1		; IF ROOM, GO BACK FOR MORE
	PUSHJ	P,CHRMOR	;MAKE ROOM, THEN GO BACK
	JRST	INS1		;

HERE (INCHWL)	PUSHJ	P,SAVE
	PUSHJ	P,REDSTR
	MOVE	LPSA,X11
	TTCALL	4,TEMP
;;#GF# DCS 2-1-72 (2-3) DO LOOP HERE, DON'T USE INS1 LIKE BEFORE
INS3:	CAIE	TEMP,12
NOCMU <	;WE WILL JUST BREAK ON CR OR LF, THANK YOU
EXPO <
	CAIN	TEMP,33		;NORMAL ALTMODE.
>;EXPO
NOEXPO <
	CAIN	TEMP,175
>;NOEXPO
	 JRST	 DNSTR
	CAIE	TEMP,15		;CR?
	TRNE	TEMP,600	;CONTROL BITS ON?
>;NOCMU
CMU <	CAIE	TEMP,15		;CR?
	CAIN	TEMP,12		; OR LF?
>;CMU
	 JRST	 DNSTR		;YES
;;%##%
	KONVERT(TEMP)
	IDPB	TEMP,TOPBYTE(USER) ;PUT IT AWAY
	TTCALL	TEMP		;GET ANOTHER AND
;;%##%  RHT -- MADE A BIT BETTER (ALLOW FOR GETTING MORE ROOM)
	AOJL	A,INS3		;GO HANDLE IT (IF STILL HAVE ROOM)
	PUSHJ	P,CHRMOR	;GET ROOM FOR MORE CHARS
	JRST	INS3		;GO HANDLE

DNSTR:	MOVEM	TEMP,.SKIP.	;SET BREAK CHAR
	JRST	FINSTR
;;#GF#

HERE (INCHSL)	PUSHJ	P,SAVE
	MOVE	LPSA,X22	;PARAM (FLAG) AND RETURN
	PUSHJ	P,REDSTR
	SETOM	@-1(P)		;ASSUME FAILED
	TTCALL	5,TEMP		;ARE THERE CHARS?
	JRST	FINSTR		;NO
	SETZM	@-1(P)		;YES, GET THEM
;;#GF# DCS 2-1-72 (3-3)
	JRST	INS3		;USE INCHWL'S LOOP, NOT INSTR'S
;;#GF#

HERE (INSTRL)	PUSHJ	P,SAVE
	MOVE	LPSA,X22
	PUSHJ	P,REDSTR
	TTCALL	4,TEMP
	MOVE	B,-1(P)
	JRST	INS2

HERE (INSTRS)	PUSHJ	P,SAVE
	MOVE	LPSA,X33
	PUSHJ	P,REDSTR
	SETOM	@-2(P)
	TTCALL	5,TEMP
	JRST	FINSTR
	SETZM	@-2(P)
	MOVE	B,-1(P)
	JRST	INS2

HERE (CLRBUF)	TTCALL	11,
	POPJ	P,

HERE (TTYINS) PUSHJ	P,SAVE
	PUSHJ	P,REDSTR	;PREPARE TO MAKE A STRING
	MOVE	LPSA,X33
	SETOM	@-1(P)		;ASSUME NO CHARS
	TTCALL	5,D		;SEE IF LINES WAITING
	 JRST	FINS1		;NONE WAINTING
;;%##% WILL DO INCHRW UUO IN LOOP
	MOVE	B,[TTCALL D]
	JRST	TYIN1		;GO AHEAD

HERE (TTYINL)
	PUSHJ	P,SAVE
	TTCALL	4,D		;WAIT FOR A LINE
	MOVE	B,[ TTCALL 4,D]
	JRST	TYIN

HERE (TTYIN)	PUSHJ	P,SAVE
	TTCALL	D		;GET A CHAR
	MOVE	B,[TTCALL D]	;FOR LOOP

TYIN:	PUSHJ	P,REDSTR	;PREPARE STACK,A,STRNGC FOR A STRING
	MOVE	LPSA,X33	;PREPARE TO RETURN
TYIN1:	SETZM	@-1(P)		;ASSUME NO BREAK CHAR
;;#TM# ! WAS -1(P)
	MOVE	X,-2(P)		;TABLE #
	MOVEI	TEMP,-1		;BLOCK MUST BE THERE AND TABLE MUST BE INIT'ED
	PUSHJ	P,BKTCHK	;CHECK TABLE #
	 JRST	FINS1		;ERROR OF SOME SORT
	MOVE	FF,BRKMSK(CHNL)	;GET MASK FOR THIS TABLE
	ADD	CHNL,CDB	;RELOCATE RANGE 1 TO 18
	MOVEI	Z,1		;FOR TESTING LINE NUMBERS
	SKIPN	LINTBL(CHNL)	;DON'T LET TEST SUCCEED IF
	 MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
;;%##% BREAK TABLE CONVERSION
	TRNE	FF,@BRKCVT(CDB)	 ;SPECIFY UC COERCION
	TLOA	C,400000	;YES
	TLZ	C,400000	;NO
;;%##%
	MOVE	Y,CDB
	ADD	Y,[XWD D,BRKTBL] ;BRKTBL+RLC(CDB)
	JRST	TTYN1
;;%##%
TTYN:	XCT	B		;1 CHAR
TTYN1:
;;%##%
	JUMPGE	C,TT.NUC	;COERCE BECAUSE OF BRK TBL ?
	CAIL	D,"a"		;ONLY IF LC
	CAILE	D,"z"
	JRST	TT.TSB		;GO TEST BREAK
	TRZ	D,40		;MAKE UC
	JRST	TT.TSB
TT.NUC:	KONVERT(D)		;MAY TURN TO UC BECAUSE OF TTY
TT.TSB:
;;%##%
	TDNE	FF,@Y		;BREAK OR OMIT?
	JRST	TTYSPC		; YES, FIND OUT WHICH
TTYC:	IDPB	D,TOPBYTE(USER)	;PUT IT AWAY
;;%##% BE SURE DONT EAT MORE AT A TIME THAN CAN BLOAT
	AOJL	A,TTYN		;COUNT AND CONTINUE
TTNMOR:	PUSHJ	P,CHRMOR	;ALLOW FOR MORE CHARS
	JRST	TTYN		;GO GO GO

TTYSPC:	HLLZ	TEMP,@Y		;WHICH?
	TDNN	TEMP,FF
	JRST	TTYN		;OMIT
	MOVEM	D,@-1(P)
	SKIPN	Y,DSPTBL(CHNL)	;GET DISPOSITION WORDD FOR THIS TABLE
	JRST	FINS1		;DONE, NO SAVE
	JUMPL	Y,TTYAPP	;APPEND
	ERR	<TTYIN: cannot retain break char>,1,FINS1
TTYAPP:	IDPB	D,TOPBYTE(USER)	;COUNT THE BREAK CHAR
	ADDI	A,1		;ONE MORE HAPPY CHAR
	JRST	FINS1

;;%##% ALLOW FOR ANOTHER CHUNK OF CHARS

CHRMOR:	ADDI	A,TTWCHR	;A ← NUMBER CHARS USED
	ADDM	A,-1(SP)	;UPDATE COUNT
;;#UI# ! 1 OF 2
	PUSH	P,TEMP		;SOME PEOPLE HAVE A CHARACTER HERE
	PUSH	P,[TTWCHR]	;GET SOME MORE
	PUSHJ	P,.SONTP	;BE SURE ROOM & ALIGNED
;;#UI# ! 2 OF 2
	POP	P,TEMP		;WE JUST SAVED THIS
	MOVNI	A,TTWCHR	;REFRESH THE COUNT
	POPJ	P,



HERE(TTYUP)
;;%##%  FLAGS TTY TRANSLATION TO UPPER CASE & RETURNS OLD FLAG
	MOVE 	USER,GOGTAB
	MOVE	A,-1(P)
	EXCH	A,TTYCVT(USER)
	SUB	P,X22
	JRST	@2(P)		;RETURN


;;%CS%
NOTENX<
NOSTANFORD<
HEREFK(BACKUP,BACKU.)
	TTYUUO	10,0
	 JFCL		;THIS CAN SKIP?
	POPJ	P,
>;NOSTANFORD
>;NOTENX
;;%CS% ↑
ENDCOM(TTY)
EXPO <
COMPIL(PTY)
ENDCOM(PTY)
>;EXPO
NOEXPO <
COMPIL(PTY,<PTYGET,PTYREL,PTIFRE,PTOCNT,PTCHRW,PTCHRS
ENTINT <PTOCHS,PTOCHW,PTOSTR,BACKUP,LODED,PTYALL,PTYSTR,PTYIN>
ENTINT <PTYSTL,PTYGTL>>
	  ,<SAVE,RESTR,X11,X22,X33,INSET,CAT,STRNGC,GOGTAB,BRKMSK,BKTCHK,.SKIP.>
	  ,<PTY ROUTINES>)
COMMENT ⊗Ptyuuo functions ⊗

	OPDEF	PTYUUO	[711B8]

DSCR PTYUUO FUNCTIONS
CAL SAIL
⊗
COMMENT ⊗
BEGIN "PTYSPC"
INTEGER PROCEDURE PTYGET;
PROCEDURE PTYREL(INTEGER LINE);
INTEGER PROCEDURE PTIFRE(INTEGER LINE);
INTEGER PROCEDURE PTOCNT(INTEGER LINE);
INTEGER PROCEDURE PTCHRS(INTEGER LINE);
PROCEDURE PTOCHS(INTEGER LINE,CHAR);
PROCEDURE PTOCHW(INTEGER LINE,CHAR);
PROCEDURE PTOSTR(INTEGER LINE; STRING INFORMATION);
PROCEDURE LODED(STRING TRYAGAIN);
STRING PROCEDURE PTYALL(INTEGER LINE);
PROCEDURE BACKUP;
STRING PROCEDURE PTYSTR(INTEGER LINE,BRCHAR);
STRING PROCEDURE PTYIN(INTEGER LINE,BKTBL; REFERENCE INTEGER BRCHAR);

END "PTYSPC"

⊗


HERE (PTYGET)
	SETOM	.SKIP.
	MOVEI	A,0
	PTYUUO	A
	SETZM	.SKIP.
	POPJ	P,

HERE (PTYREL)
	POP	P,(P)
	EXCH	A,(P)
	PTYUUO	1,A
	POP	P,A
	JRST	@2(P)

HERE (PTYGTL) PUSH	P,(P)	;ANOTHER COPY OF RETURN ADDRESS.
	PTYUUO	13,-2(P);POINT AT PTY LINE NUMBER
	MOVE	A,-1(P)	;RESULT.
	SUB	P,X33
	JRST	@3(P)	;AND RETURN.

HERE (PTYSTL) PTYUUO 14,-2(P);POINTED AT LINE NUMBER!
	SUB	P,X33
	JRST	@3(P)

HERE (PTIFRE)
	MOVE	TEMP,[PTYUUO 2,0]
	JRST	%PTY1

HERE (PTOCNT)
	SKIPA	TEMP,[PTYUUO 3,0]

HERE (PTCHRW)
	MOVE	TEMP,[PTYUUO 5,0]
%PTY1:	POP	P,(P)
	EXCH	0,(P)
	XCT	TEMP
	POP	P,0
	JRST	@2(P)

HERE (PTCHRS)
	POP	P,(P)
	EXCH	0,(P)
	PTYUUO	4,0
	MOVNI	A,1
	POP	P,0
	JRST	@2(P)

HERE (PTOCHS)
	SKIPA	TEMP,[PTYUUO 6,0]

HERE (PTOCHW)
	MOVE	TEMP,[PTYUUO 7,0]
	SETOM	.SKIP.
	POP	P,(P)
	EXCH	A,(P)
	EXCH	0,-1(P)
	XCT	TEMP
	SETZM	.SKIP.
	POP	P,A
	POP	P,0
	JRST	@3(P)

HERE (LODED)
	MOVEI	TEMP,0
	EXCH	TEMP,(P)
	PUSH	P,TEMP
	SKIPA	TEMP,[PTYUUO 15,-1(SP)]

HERE (PTOSTR)
	MOVE	TEMP,[PTYUUO  11,-1(SP)]
	PUSH	P,TEMP
	MOVE	USER,GOGTAB
	PUSHJ	P,INSET
	PUSH	SP,[1]
	PUSH	SP,[POINT 7,[0]]
	PUSHJ	P,CAT
	POP	P,TEMP
	POP	P,(P)
	POP	P,-1(SP)
	XCT	TEMP
	SUB	SP,X22
	JRST	@2(P)

HERE (BACKUP)
	TTYUUO	10,
	POPJ	P,

HERE (PTYALL)
	PUSHJ	P,SAVE
	MOVE	0,-1(P)	;LINE NUMBER
	PTYUUO	3,0
	JUMPE	A,[PUSH SP,[0]
		   PUSH SP,[0]
		   JRST ALLQ]
	MOVEI	A,=450
	ADDM	A,REMCHR(USER)
	SKIPL	REMCHR(USER)
	PUSHJ	P,STRNGC
	PUSHJ	P,INSET
	PUSH	SP,-1(P)	;PTY LINE NUMBER
	PUSH	SP,TOPBYTE(USER)	;AND BYTE POINTER.
	PTYUUO	10,-1(SP)	;AND ASK FOR ALL THAT IS THERE.
	MOVEI	B,0
	MOVE	C,(SP)		;BYTE POINTER.
;;#IN# 7-11-72 DCS TOPBYTE INVALIDLY UPDATED (ONE TOO FAR)
SOMMOR:	MOVE	LPSA,C		;LAG BY ONE		#IN#
	ILDB	0,C		;GET CHAR
	JUMPE	0,ALLDUN
	AOJA	B,SOMMOR
ALLDUN:	CAILE	B,=445
	 ERR	 <PTYALL OVERFLOW -- IT JUST CAN'T HAPPEN!!!!>
	HRROM	B,-1(SP)	;SAVE AS RESULT.
	MOVEM	LPSA,TOPBYTE(USER);THIS IS WHERE TO START ENXT ITEM. #IN#
;;#IN#
	SUBI	B,=156		;-ESTIMATE
	ADDM	B,REMCHR(USER)	;AND UPDATE FREE COUTN.
ALLQ:	MOVE	LPSA,X22
	JRST	RESTR

%REDSTR:SKIPE	SGLIGN(USER)
	PUSHJ	P,INSET
	MOVEI	A,=100
	ADDM	A,REMCHR(USER)
	SKIPLE	REMCHR(USER)
	PUSHJ	P,STRNGC
	MOVNI	A,=100
	PUSH	SP,[0]		;NULL STRING IF NOTHING DONE
	PUSH	SP,TOPBYTE(USER)
	POPJ	P,

%FINSTR:	CAIN	TEMP,15	;REMOVE LFD IF CR BROKE IT
;;#PO# ! RHT THIS USED TO BE CDB (=11) & MUNGED 12
;; USE C & D INSTEAD
	PTYUUO	5,C		;HE USED TO SAY CDB
%FINS1:	ADDM	A,REMCHR(USER)	;NUMBER NOT USED
	ADDI	A,=100		;NUMBER USED
	HRROM	A,-1(SP)	; AND TO STRING COUNT WORD
	JRST	RESTR

HERE (PTYSTR)
	PUSHJ	P,SAVE
	PUSHJ	P,%REDSTR
;;#PO#
	MOVE	C,-2(P)
	MOVE	B,-1(P)		;BREAK CHAR
	MOVE	LPSA,X33	;# TO REMOVE
;;#PO# (2 LINES)
%INS1:	PTYUUO	5,C		;NEXT CHAR
%INS2:	CAMN	D,B		;BREAK?
	 JRST	 %FINSTR		; YES, ALL DONE
;;#PO#
	IDPB	D,TOPBYTE(USER) ;PUT IT AWAY AND
	AOJA	A,%INS1		; GO BACK FOR MORE

	JRST	%INS2

HERE (PTYIN) PUSHJ	P,SAVE
;;#PO# (2 LINES)
	MOVE	C,-3(P)
	PTYUUO	5,C

%TYIN:	PUSHJ	P,%REDSTR		;PREPARE STACK,A,STRNGC FOR A STRING
	MOVE	LPSA,[XWD 4,4]		;PREPARE TO RETURN
%TYIN1:	SETZM	@-1(P)		;ASSUME NO BREAK CHAR
	MOVE	X,-2(P)		;TABLE #
	MOVEI	TEMP,-1		;BLOCK MUST BE THERE AND BE INIT'ED
	PUSHJ	P,BKTCHK	;CHECK TABLE #
	 JRST	%FINS1		;ERROR OF SOME SORT
	MOVE	FF,BRKMSK(CHNL)	;GET MASK FOR THIS TABLE
	ADD	CHNL,CDB	;RELOCATE RANGE 1 TO 18
	MOVEI	Z,1		;FOR TESTING LINE NUMBERS
	SKIPN	LINTBL(CHNL)	;DON'T LET TEST SUCCEED IF
	 MOVEI	 Z,0		;WE'RE TO LET LINE NUMBERS THRU
	MOVE	Y,CDB		;BASE OF THIS GROUP
;;#PO# !
	ADD	Y,[XWD D,BRKTBL] ;BRKTBL+RLC(CDB)
	JRST	%TTYN1
;;#PO# !
%TTYN:	PTYUUO	5,C
%TTYN1:	TDNE	FF,@Y		;BREAK OR OMIT?
	JRST	%TTYSPC		; YES, FIND OUT WHICH
;;#PO# !
%TTYC:	IDPB	D,TOPBYTE(USER)	;PUT IT AWAY
	AOJL	A,%TTYN		;COUNT AND CONTINUE
	JRST	%FINS1		;DONE
%TTYSPC: HLLZ	TEMP,@Y		;WHICH?
	TDNN	TEMP,FF
	JRST	%TTYN		;OMIT
;;#PO# !
	MOVEM	D,@-1(P)
	SKIPN	Y,DSPTBL(CHNL)	;PICK UP DISPOSITION WORD
	JRST	%FINS1		;DONE, NO SAVE
	JUMPL	Y,%TTYAPP	;APPEND
	ERR	<PTYIN: cannot retain break char>,1,%FINS1
;;#PO#
%TTYAPP: IDPB	D,TOPBYTE(USER)	;COUNT THE BREAK CHAR
	ADDI	A,1		;ONE MORE HAPPY CHAR
	JRST	%FINS1

ENDCOM(PTY)
>;NOEXPO



IFN ALWAYS,<
BEND IOSER>
DSCR BEND IOSER
⊗